CODEWITHSUNDEEP
arraysexcelvbaloops
matc
matc

Reputation: 29

Looping VBA ranges and offsetting to specific table column and other values

the VBA code below scans two different datasets/tables in excel against possible matches in Worksheet 2 (aka SecondaryTable) and Worksheet 1 (aka MainTable). Both “Main” and “Secondary” Tables are Table Objects in Excel:

Sub looping()
    Dim lRow As Long
    Dim lCol As Long
    Dim lRow2 As Long
    Dim lCol2 As Long
    Dim wordsArray() As Variant
    
    wordsArray = Worksheets("SecondaryTable").Range("A2:A" & lRow2).Value

    Dim word As Variant
    Dim cell As Range

    Set sht = Worksheets("MainTable")
    Set sht2 = Worksheets("SecondaryTable")

    lRow = sht.Range("A1").CurrentRegion.Rows.Count
    lCol = sht.Range("A1").CurrentRegion.Columns.Count
    lRow2 = sht2.Range("A1").CurrentRegion.Rows.Count
    lCol2 = sht2.Range("A1").CurrentRegion.Columns.Count

    For Each cell In Worksheets("MainTable").Range("I2:I" & lRow)
        For Each word In wordsArray
            If InStr(cell.Value, word) > 0 Then
                cell.Offset(0, -2).Value = cell.Offset(0, -2).Value & " " & word
            End If
        Next word
    Next cell
End Sub

I wanted to ask if there is any good way (after several failed attempts and errors via VBA in the last couple of days) of doing the following:

  1. Is there any way of offsetting the value identified into a specific Table column instead of counting columns to determine exactly where the data will be populated / should be offset to? I tried replacing cell.Offset(0, -2).Value with a Table reference to the column name such as “Results” however I kept getting errors.

  2. Would there any specific way after the code finds a match from wordsArray = Worksheets("SecondaryTable").Range("A2:A" & lRow2).Value to return a different value from an adjacent cell located in Range("B2:B" & lrow2).Value? The secondary table contains partial keywords in one column via which the loop is executed and a second adjacent column that contains the full name. I tried offsetting the variable word e.g., word.offset(0,1).Value in an effort to pull the name from Column 2 but only got errors.

Secondary Table example
Column A (keywords)         Column B(full string)
Dog                         big dog
Cat                         small cat

Upvotes: 0

Views: 158

Answers (1)

chris neilsen
chris neilsen

Reputation: 53136

Since you say Tables are Table Objects in Excel: utilise that fact. These are called ListObject's in VBA.

Replace the various NameOf... strings with your actual names

Sub looping()
    Dim wordsArray() As Variant
    Dim FullWordsArray() As Variant
    
    Dim wb As Workbook
    Dim sht As Worksheet
    Dim sht2 As Worksheet
    Dim loSecondary As ListObject
    Dim loMain As ListObject
    
    Set wb = ThisWorkbook ' or specify a workbook
    Set sht = wb.Worksheets("MainTable")
    Set sht2 = ws.Worksheets("SecondaryTable")
    Set loMain = sht.ListObjects(1) ' or by name: Set loMain = sht.ListObjects("YourTableName')
    Set loSecondary = sht2.ListObjects(1)
    
    ' get two arrays, one for lookup, and the other for replacements
    wordsArray = loSecondary.ListColumns("NameOfWordColumn").DataBodyRange.Value2
    FullWordsArray = loSecondary.ListColumns("NameOfFullWordColumn").DataBodyRange.Value2
    
    Dim WordIdx As Long
    Dim SearchCol As Long
    Dim UpdateCol As Long
    Dim rw As Long
    Dim lr As ListRow
    
    SearchCol = loMain.ListColumns("NameOfColumnToSearch").Index
    UpdateCol = loMain.ListColumns("NameOfColumnToUpdate").Index
    For Each lr In loMain.ListRows
        With lr.Range
            For WordIdx = 1 To UBound(wordsArray, 1)
                If InStr(.Cells(1, SearchCol).Value2, wordsArray(WordIdx, 1)) > 0 Then
                    With .Cells(1, UpdateCol)
                        .Value2 = .Value2 & " " & FullWordsArray(WordIdx, 1)
                    End With
                End If
            Next
        End With
    Next
End Sub

Upvotes: 1

Related Questions