1

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!

1 Answer 1

0

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
Sign up to request clarification or add additional context in comments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.