VBA Index match with two variables

[isabelanger]

Hi,
I have a table that looks something like this:

ID	Level1	Level2
1​	Size	Tall
1​	Weight	Heavy
1​	Colour	Brown
2​	Size	short
2​	Weight	light
2​	Colour	blue
3​	Size	medium
3​	Weight	light
3​	Colour	white

Where the same ID will appear in multiple rows but every time with a different tag on the next two columns.
I am trying to build a new table with only the sizes for every case.
For this example my original table is on cells a:c and i want to build the table on columns J:K
I have written the following code but it doesn't work:

Sub test()
Dim wsSheet1 As Worksheet
Set wsSheet1 = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long
lastRow = wsSheet1.Cells(wsSheet1.Rows.Count, "J").End(xlUp).Row

Dim i As Long
For i = 1 To lastRow
wsSheet1.Cells(i, 10).Value = WorksheetFunction.Index(wsSheet1.Range("C:C"), WorksheetFunction.Match("Size" & wsSheet1.Range("B:B"), 0), WorksheetFunction.Match(wsSheet1.Cells(i, 10), wsSheet1.Range("a:a"), 0))
Next i

End Sub

I want to use Index-Match as my actual table is very big. Could anyone help me?

 

[DanteAmor]

Hi and welcome to MrExcel.

I did not understand which columns you want as a result, so I give you 4 options:

Three result columns

Sub Build_New_Table_V1()
'Three result columns
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 3)
 
  For i = 1 To UBound(a)
    If a(i, 2) = "Size" Then
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 2) = a(i, 2)
      b(k, 3) = a(i, 3)
    End If
  Next
 
  Range("J2").Resize(k, UBound(b, 2)).Value = b
End Sub

Two columns A and B

Sub Build_New_Table_V2()
'Two columns A and B

  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 2)
 
  For i = 1 To UBound(a)
    If a(i, 2) = "Size" Then
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 2) = a(i, 2)
    End If
  Next
 
  Range("J2").Resize(k, UBound(b, 2)).Value = b
End Sub

Two columns A and C

Sub Build_New_Table_V3()
'Two columns A and C

  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 2)
 
  For i = 1 To UBound(a)
    If a(i, 2) = "Size" Then
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 2) = a(i, 3)
    End If
  Next
 
  Range("J2").Resize(k, UBound(b, 2)).Value = b
End Sub

Two columns B and C

Sub Build_New_Table_V4()
'Two columns B and C

  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 2)
 
  For i = 1 To UBound(a)
    If a(i, 2) = "Size" Then
      k = k + 1
      b(k, 1) = a(i, 2)
      b(k, 2) = a(i, 3)
    End If
  Next
 
  Range("J2").Resize(k, UBound(b, 2)).Value = b
End Sub

 

[isabelanger]

Hi and welcome to MrExcel.

I did not understand which columns you want as a result, so I give you 4 options:

Three result columns

Sub Build_New_Table_V1()
'Three result columns
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 3)
 
  For i = 1 To UBound(a)
    If a(i, 2) = "Size" Then
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 2) = a(i, 2)
      b(k, 3) = a(i, 3)
    End If
  Next
 
  Range("J2").Resize(k, UBound(b, 2)).Value = b
End Sub

Two columns A and B

Sub Build_New_Table_V2()
'Two columns A and B

  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 2)
 
  For i = 1 To UBound(a)
    If a(i, 2) = "Size" Then
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 2) = a(i, 2)
    End If
  Next
 
  Range("J2").Resize(k, UBound(b, 2)).Value = b
End Sub

Two columns A and C

Sub Build_New_Table_V3()
'Two columns A and C

  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 2)
 
  For i = 1 To UBound(a)
    If a(i, 2) = "Size" Then
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 2) = a(i, 3)
    End If
  Next
 
  Range("J2").Resize(k, UBound(b, 2)).Value = b
End Sub

Two columns B and C

Sub Build_New_Table_V4()
'Two columns B and C

  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 2)
 
  For i = 1 To UBound(a)
    If a(i, 2) = "Size" Then
      k = k + 1
      b(k, 1) = a(i, 2)
      b(k, 2) = a(i, 3)
    End If
  Next
 
  Range("J2").Resize(k, UBound(b, 2)).Value = b
End Sub

Thank you for getting back to me so fast.
I actually want to have a Code that performs this formula that I have on K2:


So that it looked for a match for the ID value and for Size, and returned the corresponding value of column C.

I will always have a the ID list of what I want to search on column J, and my reference table is from A to C; so the new table just needs to be completed.
Thanks!

 

[DanteAmor]

I actually want to have a Code that performs this formula that I have on K2:

Here's a way to make the macro faster by using a dictionary and arrays:

Sub Build_New_Table_V5()
  Dim a As Variant, b As Variant
  Dim i As Long, nRow As Long
  Dim dic As Object
 
  Set dic = CreateObject("Scripting.Dictionary")
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  b = Range("J2:K" & Range("J" & Rows.Count).End(xlUp).Row).Value
 
  For i = 1 To UBound(b)
    dic(b(i, 1)) = i
  Next
 
  For i = 1 To UBound(a)
    If dic.exists(a(i, 1)) Then
      If a(i, 2) = "Size" Then
        nRow = dic(a(i, 1))
        b(nRow, 2) = a(i, 3)
      End If
    End If
  Next
 
  Range("J2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[isabelanger]

Here's a way to make the macro faster by using a dictionary and arrays:

Sub Build_New_Table_V5()
  Dim a As Variant, b As Variant
  Dim i As Long, nRow As Long
  Dim dic As Object
 
  Set dic = CreateObject("Scripting.Dictionary")
 
  a = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  b = Range("J2:K" & Range("J" & Rows.Count).End(xlUp).Row).Value
 
  For i = 1 To UBound(b)
    dic(b(i, 1)) = i
  Next
 
  For i = 1 To UBound(a)
    If dic.exists(a(i, 1)) Then
      If a(i, 2) = "Size" Then
        nRow = dic(a(i, 1))
        b(nRow, 2) = a(i, 3)
      End If
    End If
  Next
 
  Range("J2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

It worked thanks!