Use Column Name Rather than Column Number (even after using .Offset) VBA

user_17144619 0
Viewed 91

Here is a walkthrough of the situation:

  1. My excel has 2 tabs, one called AssetName Sheet and the other called AMP Sheet

enter image description here

  1. After clicking a vba button, the user is able to generate names in column B of the AssetName Sheet

enter image description here

  1. I have another button that generates an AMP ID for the user. The easiest way for me to explain how this works is through an Index - Match function

    =IFERROR(INDEX('AMP Sheet'!$L:$L,MATCH("*"&B2&"*", 'AMP Sheet'!$B:$B,0)), "Not Found")

Column B in the AssetName Sheet is named GeneratedAssetName and column L in the AMP Sheet is named ID.

So, in this example, My_Sandwich_6S_HeroRegular_Mobile exists in the AMP Sheet. Since this is a match, it will grab the associated ID from the AMP Sheet and copy it over to column E of the AssetName Sheet:

AMP Sheet

AssetName Sheet

  1. My logic (which does the exact same thing as the function I listed in step 3) is housed within a VBA macro button. The code is shown below:

    Sub AMPTabid()

Dim wsAN As Worksheet
Set wsAN = Sheets("AssetName Sheet")

Dim wsAMP As Worksheet
Set wsAMP = Sheets("AMP Sheet")

Dim LastRow As Long
LastRow = wsAN.Cells(wsAN.Rows.Count, 2).End(xlUp).Row

Dim i As Long
For i = 2 To LastRow

 Dim rFind As range
 Set rFind = wsAMP.Columns(2).Find(what:=wsAN.Cells(i, 2), LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)

 If Not rFind Is Nothing Then
     wsAN.Cells(i, 5).Value = rFind.Offset(0, 10).Value
 End If

Next i

End Sub

Basically, I would like to use my existing code shown in step 4, but with column Names (rather than column numbers). The names I would like to use are Name and ID from the AMP Sheet.

The .Offset logic in my code is the tricky part, since it's going from column B to Column L in the AMP Sheet, so it count column L as 10, rather than 12.

Thanks!

vba excel
1 Answers

Find Headers and Lookup Values Using Application.Match

Option Explicit

Sub AMPTabid()
    
    ' Source
    Const sName As String = "AMP Sheet"
    Const slTitle As String = "Name"
    Const svTitle As String = "ID"
    ' Destination
    Const dName As String = "AssetName Sheet"
    Const dlTitle As String = "Generated Asset Name"
    Const dvTitle As String = "AMP ID"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' Table Range
    Dim shrg As Range: Set shrg = srg.Rows(1) ' Header Range
    
    ' Get the column numbers.
    Dim slCol As Variant: slCol = Application.Match(slTitle, shrg, 0) ' Lookup
    Dim svCol As Variant: svCol = Application.Match(svTitle, shrg, 0) ' Value
    
    ' Reference the data ranges.
    Dim srCount As Long: srCount = srg.Rows.Count - 1
    Dim sdrg As Range: Set sdrg = srg.Resize(srCount).Offset(1) ' Data Range
    
    ' Lookup Column Range ('Application.Match' works faster with ranges)
    Dim slrg As Range: Set slrg = sdrg.Columns(slCol) ' lookup stays in range
    
    Dim svrg As Range: Set svrg = sdrg.Columns(svCol) ' Value Range
    Dim svData As Variant: svData = svrg.Value ' value data to array
    
    ' Destination
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim drg As Range: Set drg = dws.Range("A1").CurrentRegion ' Table Range
    Dim dhrg As Range: Set dhrg = drg.Rows(1) ' Header Range
    
    ' Get the column numbers.
    Dim dlCol As Variant: dlCol = Application.Match(dlTitle, dhrg, 0) ' Lookup
    Dim dvCol As Variant: dvCol = Application.Match(dvTitle, dhrg, 0) ' Value
    
    ' Reference the data ranges.
    Dim drCount As Long: drCount = drg.Rows.Count - 1
    Dim ddrg As Range: Set ddrg = drg.Resize(drCount).Offset(1) ' Data Range
    
    Dim dlrg As Range: Set dlrg = ddrg.Columns(dlCol) ' Lookup Range
    ' The same array will be used for lookup and values (results).
    Dim dData As Variant: dData = dlrg.Value ' lookup data to array
    
    Dim dvrg As Range: Set dvrg = ddrg.Columns(dvCol) ' to be written to
    
    Dim sIndex As Variant ' Source Lookup (and Value) Index
    Dim dlValue As Variant ' Destination Lookup Value
    Dim dr As Long
    
    For dr = 1 To drCount
        dlValue = dData(dr, 1)
        If Not IsError(dlValue) Then ' exclude error values
            If Len(dlValue) > 0 Then ' exclude blanks
                sIndex = Application.Match(dlValue, slrg, 0)
                If IsNumeric(sIndex) Then ' match found
                    dData(dr, 1) = svData(sIndex, 1)
                Else ' no match found
                    dData(dr, 1) = Empty
                End If
            End If
        End If
    Next dr
    
    dvrg.Value = dData
    
    MsgBox "Ids updated.", vbInformation

End Sub
user_98140690
Related