How to change a value in a Excel table based on a value found through the match function?

user_17318501 0
Viewed 46

I want to change a value in a table based on an array of values.

These values are found through the application.match function.

Dim i As Integer
For i = 16 To 29
    If ThisWorkbook.Sheets("General").Range("A" & i) = "" Then
    
    Else
        MsgBox ThisWorkbook.Sheets("General").Range("A" & i)
        'Find value in Table
        Dim Assignments As Worksheet
        Dim TargetTable As ListObject
        Dim TargetRW As Variant
        
        Set Opdrachten = ThisWorkbook.Sheets("Jobs")
        Set TargetTable = Opdrachten.ListObjects("Assignments")
        
        TargetRW = Application.Match(i, TargetTable.ListColumns(1), 0)
        MsgBox TargetRW 'I get an error at this point'
        
        'Change value in Table
        If Not IsError(TargetRW) Then
            TargetTable.DataBodyRange.Cells(TargetRW, 6) = "Yes"
        Else
            MsgBox "Error, allready verified."
        End If
    End If
Next i
vba excel
1 Answers

A VBA Lookup in an Excel Table

Tips

  • When writing to the same rows of cells of a column range, you usually want to loop through its cells, lookup the values in another column range and write to the same rows in another column, not the other way around.

  • A type mismatch error will occur if you try to return an error in a message box. You could use an if statement to check if the value is an error and then use CStr to return its string representation, e.g.:

    If IsError(TargetRW) Then MsgBox CStr(TargetRW) Else MsgBox TargetRW

    I've opted for the shorter IIf version of the same in the code.
    Of course, you could also just do:

    MsgBox CStr(TargetRW)

    since the number is converted to a string anyways.

  • TargetTable.ListColumns(1) is a ListColumn object. To reference its range with the header or without it, you need to use either TargetTable.ListColumns(1).Range or TargetTable.ListColumns(1).DataBodyRange (in this particular case) respectively.

The Code

Option Explicit

Sub LookupJobs()
    
    ' Source (read, compare)
    Const swsName As String = "General"
    Const sRangeAddress As String = "A16:A29"
     
    ' Destination (loop, compare, write)
    Const dwsName As String = "Jobs"
    Const dtblName As String = "Assignments"
    Const dlcLookupIndex As Long = 1
    Const dlcValueIndex As Long = 6
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Reference the source worksheet and the source column range.
    Dim sws As Worksheet: Set sws = wb.Worksheets(swsName)
    Dim srg As Range: Set srg = sws.Range(sRangeAddress)
    
    ' Reference the destination worksheet, table,
    ' lookup column range (compare) and value column range (write).
    Dim dws As Worksheet: Set dws = wb.Worksheets(dwsName)
    Dim dtbl As ListObject: Set dtbl = dws.ListObjects(dtblName)
    Dim dlrg As Range: Set dlrg = dtbl.ListColumns(dlcLookupIndex).DataBodyRange
    Dim dvrg As Range: Set dvrg = dtbl.ListColumns(dlcValueIndex).DataBodyRange
    
    Dim srIndex As Variant ' current index of match in source range or error
    Dim dlCell As Range ' current cell of the destination lookup range
    Dim dValue As Variant ' value of the current cell
    Dim drIndex As Long ' index of the current cell
    
    For Each dlCell In dlrg.Cells
        drIndex = drIndex + 1
        dValue = dlCell.Value
        If Not IsError(dValue) Then ' the cell contains an error value
            If Len(dValue) > 0 Then ' the cell is not blank
                srIndex = Application.Match(dValue, srg, 0)
                'MsgBox IIf(IsError(srIndex), CStr(srIndex), srIndex)
                If IsNumeric(srIndex) Then ' match found; write
                    dvrg.Cells(drIndex).Value = "Yes"
                Else ' match not found
                    'MsgBox "Error, allready verified."
                End If
            'Else ' the cell is blank; do nothing
            End If
        'Else ' the cell contains an error value; do nothing
        End If
    Next dlCell
    
    ' Inform.
    MsgBox "Jobs lookup finished.", vbInformation
    
End Sub
user_98140690
Related