Using Vlookup in VBA how to get data in multiple rows with one cell value?

Dave Smith

New Member
Joined
Jul 5, 2021
Messages
32
Office Version
  1. 2016
Platform
  1. Windows
Hi Experts,

I am not getting proper idea of getting values in multiple rows with single cell value using vba (vba script) also i have encountered the Error "1004" while writing my program.

I have 3 sheets having name as "Sheet1","Sheet2","Sheet3"
In the sheet 1 in column it contains various "Q1, Q2,.......................,Q15" while in the row it contains value like "Inven_01 etc".
Same as "sheet1", "sheet2" also contains same values.
Now in the "sheet3" in the Range "B5" if some enters the Inven_01 then cells adjacent to Q1 to Q15 respective value should be come (while the value for Q1, Inven_01 lies in the sheet 1)

VBA Code:
Dim myLookupValue As String
Dim myFirstColumn As Long
Dim myLastColumn As Long
Dim myColumnIndex As Long
Dim myFirstRow As Long
Dim myLastRow As Long
Dim myVLookupResult As Long
    
Dim myTableArray As Range
    
myLookupValue = Worksheets("Sheet3").Range("B5")
myFirstColumn = 2
myLastColumn = 3
myColumnIndex = 2
myFirstRow = 6
myLastRow = 305
    
With Worksheets("Sheet1")
Set myTableArray = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
End With
    
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, myColumnIndex, False)

Worksheets("Sheet1").Range("B9") = myVLookupResult


End Sub


If anybody help me to sort out this it will be very helpful
 

Attachments

  • Sheet3.JPG
    Sheet3.JPG
    36.5 KB · Views: 67
  • Sheet1.JPG
    Sheet1.JPG
    86.1 KB · Views: 66
  • Sheet2.JPG
    Sheet2.JPG
    55.4 KB · Views: 65

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
I hope I have understood your requirements try this code on a copy of your workbook:
VBA Code:
Sub test()
With Worksheets("Sheet1")
last1 = .Cells(Rows.Count, "A").End(xlUp).Row
q15arr = .Range(.Cells(1, 1), .Cells(last1, 16)) ' pick up data to column P
End With
With Worksheets("Sheet2")
last2 = .Cells(Rows.Count, "A").End(xlUp).Row
q25arr = .Range(.Cells(1, 1), .Cells(last1, 16)) ' pick up data to column P
End With
With Worksheets("Sheet3")
outarr = .Range("A9:B38") ' define output
mylookupvalue = .Range("B5")
For i = 2 To last1
 If q15arr(i, 1) = mylookupvalue Then
   For j = 2 To 16
     outarr(j - 1, 2) = q15arr(i, j)
   Next j
 End If
 If q25arr(i, 1) = mylookupvalue Then
   For j = 2 To 16
     outarr(j + 14, 2) = q25arr(i, j)
   Next j
 End If
Next i
.Range("A9:B38") = outarr
End With

End Sub
 
Upvote 0
Solution
With these data in your 3 sheets.

Dante Amor
ABCDEFGHIJKLMNOP
1Q1Q2Q3Q4Q5Q6Q7Q8Q9Q10Q11Q12Q13Q14Q15
2Inven_01105010651080109511101125114011551170118512001215123012451260
3Inven_02405040654080409541104125414041554170418542004215423042454260
4Inven_03705070657080709571107125714071557170718572007215723072457260
5Inven_04705170667081709671117126714171567171718672017216723172467261
6Inven_05705270677082709771127127714271577172718772027217723272477262
7Inven_06705370687083709871137128714371587173718872037218723372487263
8Inven_07705470697084709971147129714471597174718972047219723472497264
9Inven_08705570707085710071157130714571607175719072057220723572507265
10Inven_09705670717086710171167131714671617176719172067221723672517266
11Inven_10705770727087710271177132714771627177719272077222723772527267
Sheet1


Dante Amor
ABCDEFGHIJKLMNOP
1Q25Q26Q27Q28Q29Q30Q31Q32Q33Q34Q35Q36Q37Q38Q39
2Inven_01566655865506542653465266518651065026494648664786470646264546
3Inven_02616660866006592658465766568656065526544653665286520651265046
4Inven_03666665866506642663466266618661066026594658665786570656265546
5Inven_04666765876507642763476267618761076027594758675787570756275547
6Inven_05666865886508642863486268618861086028594858685788570856285548
7Inven_06666965896509642963496269618961096029594958695789570956295549
8Inven_07667065906510643063506270619061106030595058705790571056305550
9Inven_08667165916511643163516271619161116031595158715791571156315551
10Inven_09667265926512643263526272619261126032595258725792571256325552
11Inven_10667365936513643363536273619361136033595358735793571356335553
Sheet2


Dante Amor
ABCDEFGHIJK
5Inve_strInven_01Inven_02Inven_03Inven_04Inven_05Inven_06Inven_07Inven_08Inven_09Inven_10
6
7
8
9Q11050405070507051705270537054705570567057
10Q21065406570657066706770687069707070717072
11Q31080408070807081708270837084708570867087
12Q41095409570957096709770987099710071017102
13Q51110411071107111711271137114711571167117
14Q61125412571257126712771287129713071317132
15Q71140414071407141714271437144714571467147
16Q81155415571557156715771587159716071617162
17Q91170417071707171717271737174717571767177
18Q101185418571857186718771887189719071917192
19Q111200420072007201720272037204720572067207
20Q121215421572157216721772187219722072217222
21Q131230423072307231723272337234723572367237
22Q141245424572457246724772487249725072517252
23Q151260426072607261726272637264726572667267
24Q255666616666666667666866696670667166726673
25Q265586608665866587658865896590659165926593
26Q275506600665066507650865096510651165126513
27Q285426592664266427642864296430643164326433
28Q295346584663466347634863496350635163526353
29Q305266576662666267626862696270627162726273
30Q315186568661866187618861896190619161926193
31Q325106560661066107610861096110611161126113
32Q335026552660266027602860296030603160326033
33Q344946544659465947594859495950595159525953
34Q354866536658665867586858695870587158725873
35Q364786528657865787578857895790579157925793
36Q374706520657065707570857095710571157125713
37Q384626512656265627562856295630563156325633
38Q394546504655465547554855495550555155525553
Sheet3


Try this macro:

VBA Code:
Sub VlookupQ()
  With Sheets("Sheet3").Range("B9:K38")
    .Formula = "=IFERROR(VLOOKUP(B$5,Sheet1!$A$2:$P$11,MATCH($A9,Sheet1!$A$1:$P$1,0),0),IFERROR(VLOOKUP(B$5,Sheet2!$A$2:$P$11,MATCH($A9,Sheet2!$A$1:$P$1,0),0),""""))"
    .Value = .Value
  End With
End Sub
 
Upvote 0
With these data in your 3 sheets.

Dante Amor
ABCDEFGHIJKLMNOP
1Q1Q2Q3Q4Q5Q6Q7Q8Q9Q10Q11Q12Q13Q14Q15
2Inven_01105010651080109511101125114011551170118512001215123012451260
3Inven_02405040654080409541104125414041554170418542004215423042454260
4Inven_03705070657080709571107125714071557170718572007215723072457260
5Inven_04705170667081709671117126714171567171718672017216723172467261
6Inven_05705270677082709771127127714271577172718772027217723272477262
7Inven_06705370687083709871137128714371587173718872037218723372487263
8Inven_07705470697084709971147129714471597174718972047219723472497264
9Inven_08705570707085710071157130714571607175719072057220723572507265
10Inven_09705670717086710171167131714671617176719172067221723672517266
11Inven_10705770727087710271177132714771627177719272077222723772527267
Sheet1


Dante Amor
ABCDEFGHIJKLMNOP
1Q25Q26Q27Q28Q29Q30Q31Q32Q33Q34Q35Q36Q37Q38Q39
2Inven_01566655865506542653465266518651065026494648664786470646264546
3Inven_02616660866006592658465766568656065526544653665286520651265046
4Inven_03666665866506642663466266618661066026594658665786570656265546
5Inven_04666765876507642763476267618761076027594758675787570756275547
6Inven_05666865886508642863486268618861086028594858685788570856285548
7Inven_06666965896509642963496269618961096029594958695789570956295549
8Inven_07667065906510643063506270619061106030595058705790571056305550
9Inven_08667165916511643163516271619161116031595158715791571156315551
10Inven_09667265926512643263526272619261126032595258725792571256325552
11Inven_10667365936513643363536273619361136033595358735793571356335553
Sheet2


Dante Amor
ABCDEFGHIJK
5Inve_strInven_01Inven_02Inven_03Inven_04Inven_05Inven_06Inven_07Inven_08Inven_09Inven_10
6
7
8
9Q11050405070507051705270537054705570567057
10Q21065406570657066706770687069707070717072
11Q31080408070807081708270837084708570867087
12Q41095409570957096709770987099710071017102
13Q51110411071107111711271137114711571167117
14Q61125412571257126712771287129713071317132
15Q71140414071407141714271437144714571467147
16Q81155415571557156715771587159716071617162
17Q91170417071707171717271737174717571767177
18Q101185418571857186718771887189719071917192
19Q111200420072007201720272037204720572067207
20Q121215421572157216721772187219722072217222
21Q131230423072307231723272337234723572367237
22Q141245424572457246724772487249725072517252
23Q151260426072607261726272637264726572667267
24Q255666616666666667666866696670667166726673
25Q265586608665866587658865896590659165926593
26Q275506600665066507650865096510651165126513
27Q285426592664266427642864296430643164326433
28Q295346584663466347634863496350635163526353
29Q305266576662666267626862696270627162726273
30Q315186568661866187618861896190619161926193
31Q325106560661066107610861096110611161126113
32Q335026552660266027602860296030603160326033
33Q344946544659465947594859495950595159525953
34Q354866536658665867586858695870587158725873
35Q364786528657865787578857895790579157925793
36Q374706520657065707570857095710571157125713
37Q384626512656265627562856295630563156325633
38Q394546504655465547554855495550555155525553
Sheet3


Try this macro:

VBA Code:
Sub VlookupQ()
  With Sheets("Sheet3").Range("B9:K38")
    .Formula = "=IFERROR(VLOOKUP(B$5,Sheet1!$A$2:$P$11,MATCH($A9,Sheet1!$A$1:$P$1,0),0),IFERROR(VLOOKUP(B$5,Sheet2!$A$2:$P$11,MATCH($A9,Sheet2!$A$1:$P$1,0),0),""""))"
    .Value = .Value
  End With
End Sub

With these data in your 3 sheets.

Dante Amor
ABCDEFGHIJKLMNOP
1Q1Q2Q3Q4Q5Q6Q7Q8Q9Q10Q11Q12Q13Q14Q15
2Inven_01105010651080109511101125114011551170118512001215123012451260
3Inven_02405040654080409541104125414041554170418542004215423042454260
4Inven_03705070657080709571107125714071557170718572007215723072457260
5Inven_04705170667081709671117126714171567171718672017216723172467261
6Inven_05705270677082709771127127714271577172718772027217723272477262
7Inven_06705370687083709871137128714371587173718872037218723372487263
8Inven_07705470697084709971147129714471597174718972047219723472497264
9Inven_08705570707085710071157130714571607175719072057220723572507265
10Inven_09705670717086710171167131714671617176719172067221723672517266
11Inven_10705770727087710271177132714771627177719272077222723772527267
Sheet1


Dante Amor
ABCDEFGHIJKLMNOP
1Q25Q26Q27Q28Q29Q30Q31Q32Q33Q34Q35Q36Q37Q38Q39
2Inven_01566655865506542653465266518651065026494648664786470646264546
3Inven_02616660866006592658465766568656065526544653665286520651265046
4Inven_03666665866506642663466266618661066026594658665786570656265546
5Inven_04666765876507642763476267618761076027594758675787570756275547
6Inven_05666865886508642863486268618861086028594858685788570856285548
7Inven_06666965896509642963496269618961096029594958695789570956295549
8Inven_07667065906510643063506270619061106030595058705790571056305550
9Inven_08667165916511643163516271619161116031595158715791571156315551
10Inven_09667265926512643263526272619261126032595258725792571256325552
11Inven_10667365936513643363536273619361136033595358735793571356335553
Sheet2


Dante Amor
ABCDEFGHIJK
5Inve_strInven_01Inven_02Inven_03Inven_04Inven_05Inven_06Inven_07Inven_08Inven_09Inven_10
6
7
8
9Q11050405070507051705270537054705570567057
10Q21065406570657066706770687069707070717072
11Q31080408070807081708270837084708570867087
12Q41095409570957096709770987099710071017102
13Q51110411071107111711271137114711571167117
14Q61125412571257126712771287129713071317132
15Q71140414071407141714271437144714571467147
16Q81155415571557156715771587159716071617162
17Q91170417071707171717271737174717571767177
18Q101185418571857186718771887189719071917192
19Q111200420072007201720272037204720572067207
20Q121215421572157216721772187219722072217222
21Q131230423072307231723272337234723572367237
22Q141245424572457246724772487249725072517252
23Q151260426072607261726272637264726572667267
24Q255666616666666667666866696670667166726673
25Q265586608665866587658865896590659165926593
26Q275506600665066507650865096510651165126513
27Q285426592664266427642864296430643164326433
28Q295346584663466347634863496350635163526353
29Q305266576662666267626862696270627162726273
30Q315186568661866187618861896190619161926193
31Q325106560661066107610861096110611161126113
32Q335026552660266027602860296030603160326033
33Q344946544659465947594859495950595159525953
34Q354866536658665867586858695870587158725873
35Q364786528657865787578857895790579157925793
36Q374706520657065707570857095710571157125713
37Q384626512656265627562856295630563156325633
38Q394546504655465547554855495550555155525553
Sheet3


Try this macro:

VBA Code:
Sub VlookupQ()
  With Sheets("Sheet3").Range("B9:K38")
    .Formula = "=IFERROR(VLOOKUP(B$5,Sheet1!$A$2:$P$11,MATCH($A9,Sheet1!$A$1:$P$1,0),0),IFERROR(VLOOKUP(B$5,Sheet2!$A$2:$P$11,MATCH($A9,Sheet2!$A$1:$P$1,0),0),""""))"
    .Value = .Value
  End With
End Sub
Thanks a lot @DanteAmor for giving me an other idea of view of getting the
 
Upvote 0
I hope I have understood your requirements try this code on a copy of your workbook:
VBA Code:
Sub test()
With Worksheets("Sheet1")
last1 = .Cells(Rows.Count, "A").End(xlUp).Row
q15arr = .Range(.Cells(1, 1), .Cells(last1, 16)) ' pick up data to column P
End With
With Worksheets("Sheet2")
last2 = .Cells(Rows.Count, "A").End(xlUp).Row
q25arr = .Range(.Cells(1, 1), .Cells(last1, 16)) ' pick up data to column P
End With
With Worksheets("Sheet3")
outarr = .Range("A9:B38") ' define output
mylookupvalue = .Range("B5")
For i = 2 To last1
 If q15arr(i, 1) = mylookupvalue Then
   For j = 2 To 16
     outarr(j - 1, 2) = q15arr(i, j)
   Next j
 End If
 If q25arr(i, 1) = mylookupvalue Then
   For j = 2 To 16
     outarr(j + 14, 2) = q25arr(i, j)
   Next j
 End If
Next i
.Range("A9:B38") = outarr
End With

End Sub
Thanks a lot @offthelip for sharing the vba code it worked for me
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,885
Members
452,364
Latest member
springate

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