Lookup value in sheet 1 transpose value from sheet 2 & the value in next column to sheet 1

BoyBoy

New Member
Joined
Sep 25, 2020
Messages
26
Office Version
  1. 365
Platform
  1. Windows
Hello,
I am trying to update one of my worksheet using VBA Code, by look up value from sheet 1 in column A, search the same value in sheet 2 column A (there will be duplicates), and return the value from column A and the associate value in sheet 2 column B to sheet 1 from column F to column AJ+ (depend how many storage in sheet 2 column B, could be 50+ storages)
Sheet 2 is somewhat look like this:
1604537669287.png

following is the Sheet 1 and the result data (yellow highlighted)
1604537714840.png

A simple working VBA code would be highly appreciated.
Thanks.
BoyBoy
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
When providing sample data, better if you can use XL2BB so that we can copy/paste for testing, rather than having to do a lot of manual typing. ;)

To me, it looks like the results are (or could be) obtained simply by working down Sheet2 and for each block of identical 'Vehicle Model' values, transpose the corresponding storage values to horizontal.
What does column A in Sheet1 have to do with the process?
 
Upvote 0
Oops, my bad, the column A in Sheet 1 should have been the lookup vehicle models like this:
1604553661849.png
 
Upvote 0
Vehicle Model Inventory.xlsx
N
15
Sheet1


Vehicle Model Inventory.xlsx
H
23
Sheet2
 
Upvote 0
Oops, my bad, the column A in Sheet 1 should have been the lookup vehicle models like this
Thanks. With XL2BB you need to first select the range you want to appear in the forum.

Can we be certain that every value in column A of Sheet1 appear in column A of Sheet2?
 
Upvote 0
Thanks. With XL2BB you need to first select the range you want to appear in the forum.

Can we be certain that every value in column A of Sheet1 appear in column A of Sheet2?
Yes, Sheet 2 is the master table.
Thanks.
BoyBoy
 
Upvote 0
In that case, give this a try with a copy of your workbook.
It allows for up to 100 storages for each row. You can increase/decrease that number if you want by editing the 'Const' line near the start of the code.

VBA Code:
Sub Rearrange()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, k As Long
  
  Const MaxStorages As Long = 100 '<- Edit this if required
  
  With Sheets("Sheet2")
    a = .Range("A2", .Range("B" & Rows.Count).End(xlUp).Offset(1)).Value
    c = Application.Index(a, 0, 1)
  End With
  With Sheets("Sheet1")
    b = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
    ReDim Preserve b(1 To UBound(b), 1 To MaxStorages + 1)
    For i = 1 To UBound(b)
      j = Application.Match(b(i, 1), c, 0)
      k = 2
      Do
        b(i, k) = a(j, 2)
        k = k + 1
        j = j + 1
      Loop Until a(j, 1) <> b(i, 1)
    Next i
    .Range("F2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub
 
Upvote 0
In that case, give this a try with a copy of your workbook.
It allows for up to 100 storages for each row. You can increase/decrease that number if you want by editing the 'Const' line near the start of the code.

VBA Code:
Sub Rearrange()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, k As Long
 
  Const MaxStorages As Long = 100 '<- Edit this if required
 
  With Sheets("Sheet2")
    a = .Range("A2", .Range("B" & Rows.Count).End(xlUp).Offset(1)).Value
    c = Application.Index(a, 0, 1)
  End With
  With Sheets("Sheet1")
    b = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
    ReDim Preserve b(1 To UBound(b), 1 To MaxStorages + 1)
    For i = 1 To UBound(b)
      j = Application.Match(b(i, 1), c, 0)
      k = 2
      Do
        b(i, k) = a(j, 2)
        k = k + 1
        j = j + 1
      Loop Until a(j, 1) <> b(i, 1)
    Next i
    .Range("F2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub
Thanks.
I've tried run the code, but got this error
1604559549642.png

1604559574547.png
 
Upvote 0
but got this error
That is the error that I would expect if one of the values in column A of Sheet1 is not in column A of Sheet2, which is why I asked that question in post #5. ;)

If you run the code again and when you Debug that error, hover over the 'b' of b(i,1) & it should reveal the offending value. Or hover over the 'i' in that expression & it should reveal the problem row by adding 1. That is, if it showed, say, "i = 8" then the problem would be in cell A9 of Sheet1.
 
Upvote 0
one of the values in column A of Sheet1 is not in column A of Sheet2
If that can happen, then try this version.

VBA Code:
Sub Rearrange_v2()
  Dim a As Variant, b As Variant, c As Variant, j As Variant
  Dim i As Long, k As Long
  
  Const MaxStorages As Long = 100 '<- Edit this if required
  
  With Sheets("Sheet2")
    a = .Range("A2", .Range("B" & Rows.Count).End(xlUp).Offset(1)).Value
    c = Application.Index(a, 0, 1)
  End With
  With Sheets("Sheet1")
    b = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
    ReDim Preserve b(1 To UBound(b), 1 To MaxStorages + 1)
    For i = 1 To UBound(b)
      j = Application.Match(b(i, 1), c, 0)
      If IsNumeric(j) Then
        k = 2
        Do
          b(i, k) = a(j, 2)
          k = k + 1
          j = j + 1
        Loop Until a(j, 1) <> b(i, 1)
      End If
    Next i
    .Range("F2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub

My sample data

BoyBoy.xlsm
AB
1
2No 9A
3No 9B
4No 9C
5No 9D
6No 9E
7No 9F
8No 9G
9No 9H
10No 9I
11No 8J
12No 8K
13No 8L
14No 8M
15No 4N
16No 4O
17No 4P
18No 4Q
19No 4R
20No 4S
21No 4T
22No 4U
23No 4V
24No 4W
25No 4X
Sheet2


.. and results. Note that No 44 does not appear in Sheet2 above.

BoyBoy.xlsm
ABCDEFGHIJKLMNOP
1
2No 9No 9ABCDEFGHI
3No 44No 44
4No 8No 8JKLM
Sheet1
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,044
Members
448,543
Latest member
MartinLarkin

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