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
 

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,474
Office Version
  1. 365
Platform
  1. Windows
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?
 

BoyBoy

New Member
Joined
Sep 25, 2020
Messages
26
Office Version
  1. 365
Platform
  1. Windows
Oops, my bad, the column A in Sheet 1 should have been the lookup vehicle models like this:
1604553661849.png
 

BoyBoy

New Member
Joined
Sep 25, 2020
Messages
26
Office Version
  1. 365
Platform
  1. Windows
Vehicle Model Inventory.xlsx
N
15
Sheet1


Vehicle Model Inventory.xlsx
H
23
Sheet2
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,474
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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?
 

BoyBoy

New Member
Joined
Sep 25, 2020
Messages
26
Office Version
  1. 365
Platform
  1. Windows
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
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,474
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
 

BoyBoy

New Member
Joined
Sep 25, 2020
Messages
26
Office Version
  1. 365
Platform
  1. Windows
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
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,474
Office Version
  1. 365
Platform
  1. Windows
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.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,474
Office Version
  1. 365
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,118,134
Messages
5,570,349
Members
412,320
Latest member
sixnine0312
Top