Vlookup - finding a value in more than just the left hand column

inrol

New Member
Joined
Mar 27, 2015
Messages
12
Hope someone can help with this.

I have data arranged like this -
ID1 ID2 ID3 Data1 Data2
45 56 89 aa dd
67 bb ee
91 78 cc ff

I need to get the data arranged like this -
ID ADD1 ADD2
45 aa dd
56 aa dd
67 bb ee
78 cc ff
89 aa dd
91 cc ff

This is just an example, the dataset I have is much larger.

Thank you for any help.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Hope someone can help with this.

I have data arranged like this -
ID1 ID2 ID3 Data1 Data2
45 56 89 aa dd
67 bb ee
91 78 cc ff

I need to get the data arranged like this -
ID ADD1 ADD2
45 aa dd
56 aa dd
67 bb ee
78 cc ff
89 aa dd
91 cc ff

This is just an example, the dataset I have is much larger.

Thank you for any help.

I can help you after i verify some things:

Columns A:C are IDs and columns D:F are Data?
Also do the Data columns have any blank cells?
 
Upvote 0
Hope someone can help with this.

I have data arranged like this -
ID1 ID2 ID3 Data1 Data2
45 56 89 aa dd
67 bb ee
91 78 cc ff

I need to get the data arranged like this -
ID ADD1 ADD2
45 aa dd
56 aa dd
67 bb ee
78 cc ff
89 aa dd
91 cc ff

This is just an example, the dataset I have is much larger.

Thank you for any help.

If your ID's are in columns A through C and your Data is in columns D through E
This macro will compile all of the ID's on another sheet titled "Data Results" and then use a nested vlookup to find the data in columns D and E

Code:
Sub Transpose3()
    Dim lastRow As Long
    Dim R1 As Range
    Dim R2 As Range
    Dim R3 As Range
    Dim RowN As Integer
    Dim ws As Worksheet
    
    Set ws = ActiveSheet

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Range("A1").Select
    ActiveCell.FormulaR1C1 = "ID#"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Data1"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Data2"
    Range("D1").Select
    ActiveSheet.Name = "Data Results"
    
    ws.Select
    lastRow = Range("D" & Rows.Count).End(xlUp).Row
    
    Set R1 = Range("A2:C" & lastRow)
    Set R2 = Sheets("Data Results").Range("A2")
    RowN = 0
    Application.ScreenUpdating = False
    For Each R3 In R1.Rows
        R3.Copy
        R2.Offset(RowN, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        RowN = RowN + R3.Columns.Count
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    
    Sheets("Data Results").Select
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
     Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",IFERROR(VLOOKUP(RC[-1],Sheet1!R[-1]:R[1048574],4,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C2:C5,3,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C3:C4,2,FALSE),""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("B2").AutoFill Destination:=Range("B2:B" & lastRow)
    
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]="""","""",IFERROR(VLOOKUP(RC[-2],Sheet1!R1:R1048576,5,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C2:C5,4,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C3:C5,3,FALSE),""""""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("C2").AutoFill Destination:=Range("C2:C" & lastRow)
    
    Columns("C:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
End Sub
 
Upvote 0
Thank you BlakeSkate and apologies for the delay in responding. You were correct in your assumptions about the layout, and there are gaps in the Data columns (D,E) and in the ID columns (A-C). Don't know if this affects the macro? I'll give it a try today and update the thread later.
Thanks again,
Inrol.

If your ID's are in columns A through C and your Data is in columns D through E
This macro will compile all of the ID's on another sheet titled "Data Results" and then use a nested vlookup to find the data in columns D and E

Code:
Sub Transpose3()
    Dim lastRow As Long
    Dim R1 As Range
    Dim R2 As Range
    Dim R3 As Range
    Dim RowN As Integer
    Dim ws As Worksheet
    
    Set ws = ActiveSheet

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Range("A1").Select
    ActiveCell.FormulaR1C1 = "ID#"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Data1"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Data2"
    Range("D1").Select
    ActiveSheet.Name = "Data Results"
    
    ws.Select
    lastRow = Range("D" & Rows.Count).End(xlUp).Row
    
    Set R1 = Range("A2:C" & lastRow)
    Set R2 = Sheets("Data Results").Range("A2")
    RowN = 0
    Application.ScreenUpdating = False
    For Each R3 In R1.Rows
        R3.Copy
        R2.Offset(RowN, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        RowN = RowN + R3.Columns.Count
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    
    Sheets("Data Results").Select
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
     Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",IFERROR(VLOOKUP(RC[-1],Sheet1!R[-1]:R[1048574],4,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C2:C5,3,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C3:C4,2,FALSE),""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("B2").AutoFill Destination:=Range("B2:B" & lastRow)
    
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]="""","""",IFERROR(VLOOKUP(RC[-2],Sheet1!R1:R1048576,5,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C2:C5,4,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C3:C5,3,FALSE),""""""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("C2").AutoFill Destination:=Range("C2:C" & lastRow)
    
    Columns("C:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
End Sub
 
Upvote 0
I've just tried the macro and it doesn't quite work - due to the blanks?
Here's the original data sample
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]ID1[/TD]
[TD]ID2[/TD]
[TD]ID3[/TD]
[TD]Data1[/TD]
[TD]Data2[/TD]
[/TR]
[TR]
[TD]45[/TD]
[TD]56[/TD]
[TD]89[/TD]
[TD]aa[/TD]
[TD]dd[/TD]
[/TR]
[TR]
[TD]67[/TD]
[TD][/TD]
[TD][/TD]
[TD]bb[/TD]
[TD]ee[/TD]
[/TR]
[TR]
[TD]91[/TD]
[TD]78[/TD]
[TD][/TD]
[TD]cc[/TD]
[TD]ff[/TD]
[/TR]
</tbody>[/TABLE]
And this is the result after running the macro
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]ID#

[/TD]
[TD]Data1[/TD]
[TD]Data2[/TD]
[/TR]
[TR]
[TD]45[/TD]
[TD]aa
[/TD]
[TD]dd[/TD]
[/TR]
[TR]
[TD]56[/TD]
[TD]aa[/TD]
[TD]dd[/TD]
[/TR]
[TR]
[TD]89[/TD]
[TD]aa[/TD]
[TD]dd[/TD]
[/TR]
[TR]
[TD]67[/TD]
[TD][/TD]
[TD]ee[/TD]
[/TR]
[TR]
[TD]91[/TD]
[TD][/TD]
[TD]ff[/TD]
[/TR]
[TR]
[TD]78[/TD]
[TD]cc[/TD]
[TD]ff[/TD]
[/TR]
</tbody>[/TABLE]
For some reason it's not pulling in the data for 67 & 91.

I'd also need to scale this up as the ID's could be 40 columns wide an the data columns the same, both will have spaces.

Thanks for your help and don't spend to much time as we may have to go back to the suppliers of the data and ask them to send it in a friendlier format.

Regards,
Inrol.
 
Upvote 0
Here is a completely different approach see if this solves the probelm.
Code:
Sub test()
lastrow = Range("D" & Rows.Count).End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 5))


Sheets.Add After:=ActiveSheet
outarr = Range(Cells(1, 1), Cells(lastrow * 3, 5))
indi = 2
' copy headers
 outarr(1, 1) = inarr(1, 1)
 outarr(1, 2) = inarr(1, 4)
 outarr(1, 3) = inarr(1, 5)
For i = 2 To lastrow
 For j = 1 To 3
  If inarr(i, j) <> "" Then
  
   outarr(indi, 1) = inarr(i, j)
   outarr(indi, 2) = inarr(i, 4)
   outarr(indi, 3) = inarr(i, 5)
   indi = indi + 1
  End If
 Next j
Next i


Range(Cells(1, 1), Cells(lastrow * 3, 5)) = outarr


End Sub
 
Upvote 0
That works perfectly. Thank you very much offthelip. Is it easy to adapt this, as I have many more ID and Data Columns than in the sample.

Regards
Inrol.


Here is a completely different approach see if this solves the probelm.
Code:
Sub test()
lastrow = Range("D" & Rows.Count).End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 5))


Sheets.Add After:=ActiveSheet
outarr = Range(Cells(1, 1), Cells(lastrow * 3, 5))
indi = 2
' copy headers
 outarr(1, 1) = inarr(1, 1)
 outarr(1, 2) = inarr(1, 4)
 outarr(1, 3) = inarr(1, 5)
For i = 2 To lastrow
 For j = 1 To 3
  If inarr(i, j) <> "" Then
  
   outarr(indi, 1) = inarr(i, j)
   outarr(indi, 2) = inarr(i, 4)
   outarr(indi, 3) = inarr(i, 5)
   indi = indi + 1
  End If
 Next j
Next i


Range(Cells(1, 1), Cells(lastrow * 3, 5)) = outarr


End Sub
 
Upvote 0
I've just tried the macro and it doesn't quite work - due to the blanks?

oh no lol. Its because i forgot to lock the reference on the first vlookup
You should use offthelip's though as it is faster and probably more consistent, but just in case i revised mine
this should work as long as Columns A, B, C are ID's and columns D and E are Data

Code:
Sub Transpose3()
    Dim lastRow As Long
    Dim R1 As Range
    Dim R2 As Range
    Dim R3 As Range
    Dim RowN As Integer
    Dim ws As Worksheet
    
    Set ws = ActiveSheet

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Range("A1").Select
    ActiveCell.FormulaR1C1 = "ID#"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Data1"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Data2"
    Range("D1").Select
    ActiveSheet.Name = "Data Results"
    
    ws.Select
    lastRow = Range("D" & Rows.Count).End(xlUp).Row
    
    Set R1 = Range("A2:C" & lastRow)
    Set R2 = Sheets("Data Results").Range("A2")
    RowN = 0
    Application.ScreenUpdating = False
    For Each R3 In R1.Rows
        R3.Copy
        R2.Offset(RowN, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        RowN = RowN + R3.Columns.Count
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    
    Sheets("Data Results").Select
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
     Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",IFERROR(VLOOKUP(RC[-1],Sheet1!C1:C4,4,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C2:C5,3,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C3:C4,2,FALSE),""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("B2").AutoFill Destination:=Range("B2:B" & lastRow)
    
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]="""","""",IFERROR(VLOOKUP(RC[-2],Sheet1!R1:R1048576,5,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C2:C5,4,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C3:C5,3,FALSE),""""""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("C2").AutoFill Destination:=Range("C2:C" & lastRow)
    
    Columns("C:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
End Sub

As far as adapting the code to different ID and Data columns do you mean that they will be in different columns?
 
Last edited:
Upvote 0
Hi and thanks for looking at this again. Yes the actual ID's could be in any number of columns as could the DATA. I'm happy to edit the macro to suit the data as it's submitted, but I'm not sure what part of the macro refers to the ID columns and what part refers to the DATA columns. Sort of hoping that the macro would say something like look 'in the first 3 columns for ID's and the next 2 columns for DATA'. I could then amend this so that it looked in the appropriate number of columns - think I'm asking too much!

Regards,
Inrol.


oh no lol. Its because i forgot to lock the reference on the first vlookup
You should use offthelip's though as it is faster and probably more consistent, but just in case i revised mine
this should work as long as Columns A, B, C are ID's and columns D and E are Data

Code:
Sub Transpose3()
    Dim lastRow As Long
    Dim R1 As Range
    Dim R2 As Range
    Dim R3 As Range
    Dim RowN As Integer
    Dim ws As Worksheet
    
    Set ws = ActiveSheet

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Range("A1").Select
    ActiveCell.FormulaR1C1 = "ID#"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Data1"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Data2"
    Range("D1").Select
    ActiveSheet.Name = "Data Results"
    
    ws.Select
    lastRow = Range("D" & Rows.Count).End(xlUp).Row
    
    Set R1 = Range("A2:C" & lastRow)
    Set R2 = Sheets("Data Results").Range("A2")
    RowN = 0
    Application.ScreenUpdating = False
    For Each R3 In R1.Rows
        R3.Copy
        R2.Offset(RowN, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        RowN = RowN + R3.Columns.Count
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    
    Sheets("Data Results").Select
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
     Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",IFERROR(VLOOKUP(RC[-1],Sheet1!C1:C4,4,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C2:C5,3,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C3:C4,2,FALSE),""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("B2").AutoFill Destination:=Range("B2:B" & lastRow)
    
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]="""","""",IFERROR(VLOOKUP(RC[-2],Sheet1!R1:R1048576,5,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C2:C5,4,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C3:C5,3,FALSE),""""""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("C2").AutoFill Destination:=Range("C2:C" & lastRow)
    
    Columns("C:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
End Sub

As far as adapting the code to different ID and Data columns do you mean that they will be in different columns?
 
Upvote 0
Hi and thanks for looking at this again. Yes the actual ID's could be in any number of columns as could the DATA. I'm happy to edit the macro to suit the data as it's submitted, but I'm not sure what part of the macro refers to the ID columns and what part refers to the DATA columns. Sort of hoping that the macro would say something like look 'in the first 3 columns for ID's and the next 2 columns for DATA'. I could then amend this so that it looked in the appropriate number of columns - think I'm asking too much!

Regards,
Inrol.

yeah let me add notes to mine and maybe offthelip will with their code.
My brain doesnt think in that way offthelip's code is written so it'd be best if they tell you what to change in that lol.
If you aren't really sure how normal vlookups work even with my notes it will be confusing but i tried my best
You may want to look up R1C1 style formulas if you'll be working in VBA



Code:
Sub Transpose3()
    Dim lastRow As Long
    Dim R1 As Range
    Dim R2 As Range
    Dim R3 As Range
    Dim RowN As Integer
    Dim ws As Worksheet
    
    Set ws = ActiveSheet

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Range("A1").Select
    ' ----------------- this is just naming the headers on the new sheet "Data Results" you can add more data columns in D1 and beyond by copying these and changing them to the appropriate cells -----------------------
    ActiveCell.FormulaR1C1 = "ID#"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Data1"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Data2"
    ActiveSheet.Name = "Data Results"
    
    ws.Select
    lastRow = Range("D" & Rows.Count).End(xlUp).Row
    
    ' ----------------- A2:C below here refers to the range of your IDs, you can change this to fit your needs --------------
    
    Set R1 = Range("A2:C" & lastRow)
    Set R2 = Sheets("Data Results").Range("A2")
    RowN = 0
    Application.ScreenUpdating = False
    For Each R3 In R1.Rows
        R3.Copy
        R2.Offset(RowN, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        RowN = RowN + R3.Columns.Count
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    
    Sheets("Data Results").Select
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
' ---------------------- Everything below this point are the vlookups, Range B2 is Data 1 or the first cell of data. Change "Sheet1" to match the sheet name where the IDs and Data is wherever you see it. C1:C4 refers to columns 1-4 as the lookup range, and the ", 4, false" is telling us we want the 4th column returned as the value. Change these ranges based on your needs. Note that the first column you look up must contain the ID and the last column must be the Data ----------------------------------
     Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",IFERROR(VLOOKUP(RC[-1],Sheet1!C1:C4,4,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C2:C5,3,FALSE),IFERROR(VLOOKUP(RC[-1],Sheet1!C3:C4,2,FALSE),""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("B2").AutoFill Destination:=Range("B2:B" & lastRow)
    
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 ' --------------------- Range C2 is like B2 but for Data2 --------------------------
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]="""","""",IFERROR(VLOOKUP(RC[-2],Sheet1!R1:R1048576,5,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C2:C5,4,FALSE),IFERROR(VLOOKUP(RC[-2],Sheet1!C3:C5,3,FALSE),""""""""))))"
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("C2").AutoFill Destination:=Range("C2:C" & lastRow)
    
    Columns("C:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
End Sub

Here are some helpful tools to understanding my vlookup that you can change to suit your needs. Especially if you'll be working with VBA and excel in the future
https://www.ablebits.com/office-addins-blog/2018/02/15/excel-iferror-vlookup/
https://excelribbon.tips.net/T008803_Understanding_R1C1_References.html
 
Upvote 0

Forum statistics

Threads
1,223,898
Messages
6,175,274
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top