• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Vlookup Macro with a Match Function as the Column Index

Tejlorka

New Member
Hi, I am pretty new to macros and am trying to figure out how I can modify an existing one I have that performs a vlookup. Ideally, I can put a match formula in where the column index number 5 is located that can referencing the column headers in my data upload sheet. Without the match I have to modify my data upload format creating more columns than just adding rows. Also I wouldnt need a new lookup to input data into every column as I can just add that criteria to the data file.

>>> use code - tags <<<
Code:
Sub VlookuptoSource()

    Dim listWs As Worksheet, dataWs As Worksheet
    Dim listLastRow As Long, dataLastRow As Long, x As Long
    Dim ListRng As Range
   
    Set listWs = ThisWorkbook.Worksheets("Check_List")
    Set dataWs = ThisWorkbook.Worksheets("New_Source")
       
    listLastRow = listWs.Range("C" & Rows.Count).End(xlUp).Row
    dataLastRow = dataWs.Range("B" & Rows.Count).End(xlUp).Row
   
  
    Set ListRng = listWs.Range("C3:G" & listLastRow)
  
    For x = 2 To dataLastRow
   
    On Error Resume Next
        If listWs.Range("G5").Value = 1 Then
        dataWs.Range("C" & x).Value = Application.WorksheetFunction.Vlookup(dataWs.Range("B" & x).Value, ListRng, 5, False)
        End If
        If listWs.Range("G5").Value = 2 Then
        dataWs.Range("D" & x).Value = Application.WorksheetFunction.Vlookup(dataWs.Range("B" & x).Value, ListRng, 5, False)
        End If
        If listWs.Range("G5").Value = 3 Then
        dataWs.Range("E" & x).Value = Application.WorksheetFunction.Vlookup(dataWs.Range("B" & x).Value, ListRng, 5, False)
        End If
        If listWs.Range("G5").Value = 4 Then
        dataWs.Range("F" & x).Value = Application.WorksheetFunction.Vlookup(dataWs.Range("B" & x).Value, ListRng, 5, False)
        End If
        'If listWs.Range("G5").Value = 5 Then
        'dataWs.Range("G" & x).Value = Application.WorksheetFunction.Vlookup(dataWs.Range("B" & x).Value, ListRng, 5, False)
        'End If

  
    Next x

End Sub

Any help would be greatly appreciated!!!!

Thanks,

Taylor
 
Last edited by a moderator:
Tejlorka
You should able to send a sample of Your Excel-files with expected results
that others could get better image of Your challenge.
I tried to modify one part of Your code.
I didn't test it.
Code:
Sub VlookuptoSource()
    On Error Resume Next
    Dim listWs As Worksheet, dataWs As Worksheet
    Dim listLastRow As Long, dataLastRow As Long, x As Long
    Dim ListRng As Range   
    Set listWs = ThisWorkbook.Worksheets("Check_List")
    Set dataWs = ThisWorkbook.Worksheets("New_Source")
    listLastRow = listWs.Range("C" & Rows.Count).End(xlUp).Row
    dataLastRow = dataWs.Range("B" & Rows.Count).End(xlUp).Row
    Set ListRng = listWs.Range("C3:G" & listLastRow)
    For y = 2 To dataLastRow
        Err.Clear
        If listWs.Range("G5").Value = y - 1 Then _
            dataWs.Cells(y, 1 + y) = WorksheetFunction.VLookup(dataWs.Range("B" & x), ListRng, 5, False)
    Next y
End Sub
 
Hi Vletm,

Attached is a file showing what I am trying to do. I do see that moving forward this would be a better approach as I dont know if I explained it well. I want to input a match as the column index in a vlookup and in my current code it looks like it would replace this <dataWs.Range("C" & x)> designation for the column as it would load in as a row. Right now, my solution is working on inputting my data into the 'Old_Source' but I am looking to have it setup as the New_Source. Sorry for the confusion or if this caused any extra work. Any suggestions or help you may have would be greatly appreciated.

Thanks!
T
 

Attachments

  • Ex Workbook.xlsm
    21.4 KB · Views: 6
Tejlorka
I would do that with Match-function.
One sample for You.
Do Your Select Offering Below from cell E2...
Select cell F2 to [ SAVE ] to New_Source
Select cell G2 to [ LOAD ] from New_Source
 

Attachments

  • Ex Workbook.xlsm
    25.5 KB · Views: 6
Last edited:
Another way:
Code:
Sub TESTVlookup()
Dim listWs As Worksheet, dataWs As Worksheet
Dim listLastRow As Long, dataLastRow As Long, x As Long, Colm As Long
Dim ListRng As Range
    
Set listWs = ThisWorkbook.Worksheets("Check_List")
Set dataWs = ThisWorkbook.Worksheets("Old_Source")
        
listLastRow = listWs.Range("C" & Rows.Count).End(xlUp).Row
dataLastRow = dataWs.Range("A" & Rows.Count).End(xlUp).Row
    
  
Set ListRng = listWs.Range("C4:E" & listLastRow)
Colm = Application.Match(listWs.Range("E2").Value, dataWs.Rows(1), 0) 'destination column number
If Not IsError(Colm) Then 'check the column's been found.
  For x = 2 To dataLastRow
    dataWs.Cells(x, Colm).Value = Application.WorksheetFunction.Vlookup(dataWs.Range("A" & x).Value, ListRng, 3, False)
  Next x
End If
End Sub
Now you no longer need the Tables sheet to look up the column number. You can probably do without it for the data validation too. I've shown in cell J2 that you can obtain the data validation list from the top row of the Old_Source sheet instead.
 

Attachments

  • Chandoo47869Ex Workbook.xlsm
    22.6 KB · Views: 3
Another way:
Code:
Sub TESTVlookup()
Dim listWs As Worksheet, dataWs As Worksheet
Dim listLastRow As Long, dataLastRow As Long, x As Long, Colm As Long
Dim ListRng As Range
   
Set listWs = ThisWorkbook.Worksheets("Check_List")
Set dataWs = ThisWorkbook.Worksheets("Old_Source")
       
listLastRow = listWs.Range("C" & Rows.Count).End(xlUp).Row
dataLastRow = dataWs.Range("A" & Rows.Count).End(xlUp).Row
   
 
Set ListRng = listWs.Range("C4:E" & listLastRow)
Colm = Application.Match(listWs.Range("E2").Value, dataWs.Rows(1), 0) 'destination column number
If Not IsError(Colm) Then 'check the column's been found.
  For x = 2 To dataLastRow
    dataWs.Cells(x, Colm).Value = Application.WorksheetFunction.Vlookup(dataWs.Range("A" & x).Value, ListRng, 3, False)
  Next x
End If
End Sub
Now you no longer need the Tables sheet to look up the column number. You can probably do without it for the data validation too. I've shown in cell J2 that you can obtain the data validation list from the top row of the Old_Source sheet instead.

Thank you! These are helpful tips. However, Inam looking to move the input of the data into the format in the New_Source sheet and am having trouble transposing the code to work for inputting into the rows based on the column headers in row 1.
 
Tejlorka
I would do that with Match-function.
One sample for You.
Do Your Select Offering Below from cell E2...
Select cell F2 to [ SAVE ] to New_Source
Select cell G2 to [ LOAD ] from New_Source
This is very impressive! Thank you for sending. I was having trouble seeing any code in the Developer sheet before and then somehow the document was no longer available but now everything is working and I can work this into my real-life example. Thank you so much for your help!
 
OK, then try:
Code:
Sub TESTVlookup()
Dim listWs As Worksheet, dataWs As Worksheet
Dim listLastRow As Long, dataLastRow As Long, x As Long, DestnRow As Long
Dim ListRng As Range
   
Set listWs = ThisWorkbook.Worksheets("Check_List")
Set dataWs = ThisWorkbook.Worksheets("New_Source")
       
listLastRow = listWs.Range("C" & Rows.Count).End(xlUp).Row
 
Set ListRng = listWs.Range("E4:E" & listLastRow)
DestnRow = Application.Match(listWs.Range("E2").Value, dataWs.Columns(1), 0)
If Not IsError(DestnRow) Then    'check the row's been found.
  dataWs.Cells(DestnRow, "B").Resize(, ListRng.Rows.Count).Value = Application.Transpose(ListRng.Value)
End If
End Sub
See attached.
It assumes the headers at the top of the New_Source sheet are in the same order as the values in column C of the Check_List sheet.
 

Attachments

  • Chandoo47869Ex Workbook v2.xlsm
    19.9 KB · Views: 4
OK, then try:
Code:
Sub TESTVlookup()
Dim listWs As Worksheet, dataWs As Worksheet
Dim listLastRow As Long, dataLastRow As Long, x As Long, DestnRow As Long
Dim ListRng As Range
  
Set listWs = ThisWorkbook.Worksheets("Check_List")
Set dataWs = ThisWorkbook.Worksheets("New_Source")
      
listLastRow = listWs.Range("C" & Rows.Count).End(xlUp).Row

Set ListRng = listWs.Range("E4:E" & listLastRow)
DestnRow = Application.Match(listWs.Range("E2").Value, dataWs.Columns(1), 0)
If Not IsError(DestnRow) Then    'check the row's been found.
  dataWs.Cells(DestnRow, "B").Resize(, ListRng.Rows.Count).Value = Application.Transpose(ListRng.Value)
End If
End Sub
See attached.
It assumes the headers at the top of the New_Source sheet are in the same order as the values in column C of the Check_List sheet.
Thank you so much! This works...I didnt think about the ordering of the columns in the New_Source sheet because with a lookup it wouldnt have mattered but that is a great point. Thank you and I hope you have a happy friday!
 
Back
Top