Pagename: vba-excel - Vba-excel
Category:Array
Post Count: 5Category:Programming
Pagename: vba-excel - Vba-excel

VBA – Excel – Determine and set data range

Use:

Function LastRowInt(InWS As Worksheet) As Integer
  LastRowInt = InWS.UsedRange.Find(What:="*", After:=InWS.Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
End Function

Public Function DataRng(FirstCell As Range, WS As Worksheet) As Range
    'Function to determine and return the true used range of the specified Worksheet
    Dim LastCell As Range, LastRow As Range, LastCol As Range
    
    Set LastRow = WS.Rows(WS.UsedRange.Find(What:="*", After:=FirstCell, Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row)
    
    Set LastCol = WS.Columns(WS.UsedRange.Find(What:="*", After:=FirstCell, Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column)
    
    Set LastCell = Application.Intersect(LastRow, LastCol)
    
    Set DataRng = WS.Range(FirstCell, LastCell)
End Function

 

 

Function LastRowInt(InWS As Worksheet) As Integer
  LastRowInt = InWS.UsedRange.Find(What:="*", After:=InWS.Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
End Function

Public Function DataRng(FirstCell As Range, WS As Worksheet) As Range
'Function to determine and return the true used range of the specified Worksheet
Dim LastCell As Range, LastRow As Range, LastCol As Range

Set LastRow = WS.Rows(WS.UsedRange.Find(What:="*", After:=FirstCell, Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row)

Set LastCol = WS.Columns(WS.UsedRange.Find(What:="*", After:=FirstCell, Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column)

Set LastCell = Application.Intersect(LastRow, LastCol)

Set DataRng = WS.Range(FirstCell, LastCell)
End Function

 

Ron De Bruin: http://www.rondebruin.nl/win/s9/win005.htm

Last Function:

Function Last(choice As Long, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
    Dim lrw As Long
    Dim lcol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
End Function

Contextures: http://www.contextures.com/xlfaqApp.html#Unused Reset used range:

Sub DeleteUnused()
  

Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range


For Each wks In ActiveWorkbook.Worksheets
  With wks
    myLastRow = 0
    myLastCol = 0
    Set dummyRng = .UsedRange
    On Error Resume Next
    myLastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row
    myLastCol = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByColumns).Column
    On Error GoTo 0

    If myLastRow * myLastCol = 0 Then
        .Columns.Delete
    Else
        .Range(.Cells(myLastRow + 1, 1), _
          .Cells(.Rows.Count, 1)).EntireRow.Delete
        .Range(.Cells(1, myLastCol + 1), _
          .Cells(1, .Columns.Count)).EntireColumn.Delete
    End If
  End With
Next wks

End Sub

'================================

Sub TestForMergedCells()

  Dim AnyMerged As Variant

  AnyMerged = ActiveSheet.UsedRange.MergeCells

  If AnyMerged = False Then
      MsgBox "no merged"
  ElseIf AnyMerged = True Then
      MsgBox "all merged"
  ElseIf IsNull(AnyMerged) Then
      MsgBox "mixture"
  Else
      MsgBox "never gets here--only 3 options"
  End If

End Sub
'=====================================

Chip Person: http://www.cpearson.com/excel/LastCell.aspx
Has similar function

When just want to specify the last row # ie for data lookup etc

Leave a Reply

Your email address will not be published. Required fields are marked *

Category:Programming
Pagename: vba-excel - Vba-excel

VBA – Excel – Tips on Learning VBA

Every now and again I am asked what is the best method to learn VBA. On this topic here are my thoughts on learning VBA…

  1. It can be a hard slog – I feel the need to warn anyone that is taking their first foray into programming that learning VBA can require a steep learning curve, depending on your background. By recording macros a user can typically make some adjustments for basic automation tasks. However, to utilize the full capabilities of VBA an understanding of basic programming and knowledge of the object model is required. This can mean a lot of work for some people and it just be worth it. Having said that, for some, it can pay dividends and it can be an interesting subject to spend time on.
  2. Recording Macros – For basic tasks and to aid learning, it is often useful to just record macros while you manually do the task you would like to automate. Then view the code produced by the recorder. By using the recorded macro as a starting point and modifying the code, if required, to meet your specific needs can give some insight into the object model used and the methods and arguments to use.
  3. Basic Programming – There is so much great info available these days that it should not take long to obtain some content that takes you through the basics of programming. What I would recommend here though is to try and find content that is project based. That is, content that takes you through building something for yourself. Doing the coding is always going to be superior to just reading about it. Making typos and other types of errors and then learning to find and correct those errors is all part of programming and is a core skill to develop.
  4. Exercises – Start setting yourself projects that push your current VBA knowledge. It can be a lot of work but can also be very fulfilling. For me, this is where I have found that I have learnt the most. In the same vain, it can be useful to find those sites or groups where users ask questions for others to answer. Solving issues for others can be good practice and sometimes can provide insight into the type of uses that people use VBA for.

 

Those are the steps that I have personally taken. In the end it seems there are no real short cuts. Getting experience under the belt was what counted for me. Luckily for me I do find programming to be an inherently challenging and interesting activity.  Good luck to those who are just starting out.

Leave a Reply

Your email address will not be published. Required fields are marked *

Category:Programming
Pagename: vba-excel - Vba-excel

VBA – Excel – Count the Number of Matching Words in Two Strings

Possibly useful to sort, order or compare lists of non-identical but related strings.

Public Function MatchingWordsInStrings(InString1 As String, InString2 As String) As Integer

'Loop through two strings, counting the number of matches that exist - useful as a rough comparison of similarity
Dim StrArr1() As String, StrArr2() As String
Dim RetCnt As Integer: RetCnt = 0
Dim Ele1 As Variant, Ele2 As Variant

'If either string is empty, no comparison can be done, return 0
If InString1 = "" Or InString2 = "" Then
MatchingWordsInStrings = 0
Exit Function
End If

'Split strings into arrays of words to allow comparison
StrArr1 = Split(InString1, " ")
StrArr2 = Split(InString2, " ")

'Compare each word in first array with each word in 2nd array
For Each Ele1 In StrArr1
    For Each Ele2 In StrArr2
        If Ele1 = Ele2 Then
            RetCnt = RetCnt + 1
            Exit For
        End If
    Next Ele2
Next Ele1

MatchingWordsInStrings = RetCnt
End Function

Leave a Reply

Your email address will not be published. Required fields are marked *

Category:Programming
Pagename: vba-excel - Vba-excel

VBA – Excel – Routine to position shapes in range

Routine to position shapes in worksheet based on specified ranges.

Note: Can use ‘print shape name‘ routine to create required list. See snippet below.

Sub RunPlaceShapeInRange()
    'Routine to place specified shape in specified range
    Dim CWS As Worksheet
    
    Set CWS = ChartSht 'Change this to specific worksheet object
     
    'Uncomment line below to specify worksheet name
    'Set CWS = ThisWorkbook.Worksheets("WorksheetName")
    
    Call PlaceShapeInRange("Shape No1", "D2:G4", CWS)
End Sub

Sub PlaceShapeInRange(ShapeName As String, RangeStr As String, InWS As Worksheet)
    'Routine to place specified shape in specified range. Run from: RunPlaceShapeInRange
    
    Dim CShape As Shape
    Dim CRange As Range
    
    Set CShape = InWS.Shapes(ShapeName)
    Set CRange = InWS.Range(RangeStr)
    
    CShape.Left = CRange.Left
    CShape.Top = CRange.Top
    CShape.Width = CRange.Width
    CShape.Height = CRange.Height
    
End Sub

To position a lot of shapes (which is the main point of this routine), a list can be quickly generated using the ‘print shape names‘ routine and inserting something like:

Debug.Print "Call PlaceShapeInRange(" & Chr(34) & CShape.Name & Chr(34) & ", " & Chr(34) & "Range" & Chr(34) & ", CWS)"

in the appropriate position. This will produce something like:

Call PlaceShapeInRange(“SalesChart”, “Range”, CWS)
Call PlaceShapeInRange(“Salesman”, “Range”, CWS)
Call PlaceShapeInRange(“Current (Y/N)”, “Range”, CWS)

Which then requires the specified range to be typed in.

Example:

Sub RunPlaceShapeInRange()
    'Routine to place specified shape in specified range
    Dim CWS As Worksheet
    
    Set CWS = ChartSht 'Change this to specific worksheet object
     
    'Uncomment line below to specify worksheet name
    'Set CWS = ThisWorkbook.Worksheets("WorksheetName")
    
    Call PlaceShapeInRange("SalesChart", "I6:V38", CWS)
    Call PlaceShapeInRange("Salesman", "F6:G25", CWS)
    Call PlaceShapeInRange("Current (Y/N)", "F40:G44", CWS)
    Call PlaceShapeInRange("Year", "I2:P4", CWS)
    Call PlaceShapeInRange("Acc size", "X2:AF4", CWS)
   
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *

Category:Programming
Pagename: vba-excel - Vba-excel

VBA – Excel – Print All Shape Names Routine

Routine to list names of shapes in specific worksheet or current workbook. Can make adjustments here to list various shape properties.

Sub RunPrintShapeNames()
    'Specify a single worksheet specified to list shapes in that worksheet
    '   or leave empty  to list all shapes within all worksheets in workbook
    Dim CWS As Worksheet
    
    Set CWS = ChartSht 'Change this to specific worksheet object
    
    'Uncomment line below to specify worksheet name
    'Set CWS = ThisWorkbook.Worksheets("WorksheetName")
    
    Call PrintShapeNames(CWS)
End Sub

Sub PrintShapeNames(Optional InWS As Worksheet)
    'Routine to list all shape names
    'Run from 'RunPrintShapeNames' with either a single worksheet specified to list shapes in that worksheet
    '   or leave empty  to list all shapes within all worksheets in workbook
    Dim CWS As Worksheet
    Dim CShape As Shape
    
    If Not InWS Is Nothing Then
        For Each CShape In InWS.Shapes
            Debug.Print CShape.Name
        Next CShape
    Else
        For Each CWS In ThisWorkbook.Worksheets
            For Each CShape In CWS.Shapes
                Debug.Print CWS.Name & ": " & CShape.Name
            Next CShape
        Next CWS
    End If

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *