VBA based multiple column index-match macro that uses user inputs.

[Bassie]

Hey everyone!

Maybe its a bit of a hard to understand question but I will try my best.

I am creating a custom ribbon and in this ribbon I want a "Easy index-match" button. When the user presses this button 3 pomps in a row will pop up.

The first prompt will ask the user to select the target table that the user wants to fill in.
The second prompt will ask the user to select the raw data table where the information should be gathered from.
The third prompt will list all headers that are both in the first and second prompt and ask the user to select a header which should be used as the column to match values against.

After this I want the macro to fill in the fill in table basically doing multiple index-matches and filling in all cells that can be filled in (would be nice if this also works to the left and not only to the right as a vlookup).
To make it more clear I added a XL2BB table below. (The "expected outcome" should be in the place of the first table)

Bobba.xlsm
	A	B	C	D	E	F	G	H	I
1	Fill in data table					Raw data table
2	Header #1	Header #2	Header #3	Header #4		Header #1	Header #4	Header #5	Header #2
3		2				z	y	x	2
4		3				z1	y1	x1	3
5		4				z2	y2	x2	1
6		1				z3	y3	x3	5
7		2				z4	y4	x4	4
8						z5	y5	x5	8
9
10
11
12
13	Expected outcome
14	Header #1	Header #2	Header #3	Header #4
15	z	2		y
16	z1	3		y1
17	z4	4		y4
18	z2	1		y2
19	z	2		y
Sheet1

I hope my question is and thanks a ton in advance,
Bassie

 

[DanteAmor]

Hello @Bassie.

Thanks for posting on MrExcel board.​

If the ranges are fixed or something. You only need one formula:

Dante Amor
	A	B	C	D	E	F	G	H	I
1	Fill in data table					Raw data table
2	Header #1	Header #2	Header #3	Header #4		Header #1	Header #4	Header #5	Header #2
3	z	2		y		z	y	x	2
4	z1	3		y1		z1	y1	x1	3
5	z4	4		y4		z2	y2	x2	1
6	z2	1		y2		z3	y3	x3	5
7	z	2		y		z4	y4	x4	4
8						z5	y5	x5	8
Hoja1

Cell Formulas
Range	Formula
A3:A7,C3:D7	C3	=IFERROR(INDEX($F$2:$I$8,MATCH($B3,$I$2:$I$8,0),MATCH(C$2,$F$2:$I$2,0)),"")

But if you need to enter the ranges with inputbox.
Then according to your example, in the first inputbox you should select the range A2:D7, in the second range F2:I8 and in the third only cell B2.

Try the following macro:

Sub UserInputs()
  Dim input1 As Variant, input2 As Variant, input3 As Variant
  Dim header1 As String, header2 As String
  Dim a As Variant, b As Variant
  Dim cola As Long, colb As Long, col2 As Long, fil2 As Long
  Dim dicH As Object, dicR As Object
  Dim i As Long, j As Long
  
  On Error Resume Next
  With Application
    Set input1 = .InputBox("Select the target table", _
      "Table to fill", Range("A2").Address, Type:=8)
      If input1 Is Nothing Then Exit Sub
      header1 = Join(Application.Index(input1.Value, 1), ", ")
    
    Set input2 = .InputBox("Select the raw data", _
      "table where the information should be gathered from", _
      Range("F2").Address, Type:=8)
      If input2 Is Nothing Then Exit Sub
      header2 = Join(Application.Index(input2.Value, 1), ", ")
    
    Set input3 = .InputBox("Select a header" & vbCr & _
      "Header1: " & header1 & vbCr & "Header2: " & header2, _
      "which should be used as the column to match values against", _
      Range("B2").Address, Type:=8)
      If input3 Is Nothing Then Exit Sub
  End With
  On Error GoTo 0
  
  a = input1.Value
  b = input2.Value
  Set dicH = CreateObject("Scripting.Dictionary")
  Set dicR = CreateObject("Scripting.Dictionary")
  
  For j = 1 To UBound(b, 2)
    dicH(b(1, j)) = j
    If b(1, j) = input3.Cells(1).Value Then
      colb = j
    End If
  Next
  For i = 1 To UBound(b, 1)
    dicR(b(i, colb)) = i
  Next
  
  For j = 1 To UBound(a, 2)
    If a(1, j) = input3.Cells(1).Value Then
      cola = j
    End If
  Next
  
  For j = 1 To UBound(a, 2)
    If j <> cola Then
      col2 = dicH(a(1, j))
      If col2 <> 0 Then
        For i = 2 To UBound(a, 1)
          fil2 = dicR(a(i, cola))
          a(i, j) = b(fil2, col2)
        Next
      End If
    End If
  Next
  
  input1.Value = a
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[Bassie]

Hey,

Thanks a ton!
I sometimes get a run-time error '9' when the subscript is out of range. in the following line:

   a(i, j) = b(fil2, col2)

Do you know why this is happening?

Big thanks again its magical,
Regards

 

[Bassie]

Hey,

Thanks a ton!
I sometimes get a run-time error '9' when the subscript is out of range. in the following line:

   a(i, j) = b(fil2, col2)

Do you know why this is happening?

Big thanks again its magical,
Regards

I think it has something to do with when a value from the input 3 column in the input 1 table cant be matched with a value from input 3 table.

But not sure

 

[DanteAmor]

I think it has something to do with when a value from the input 3 column in the input 1 table cant be matched with a value from input 3 table.

It is a scenario that I did not test. I assumed that the data in table1 always existed in table2.


But it's a small change in the macro.
Change this line:

a(i, j) = b(fil2, col2)

By this line:

If fil2 > 0 Then a(i, j) = b(fil2, col2)

--------------
Please, try your scenarios again, if there is one in particular, come back here, put the data with which you are testing, so I can review it and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[Bassie]

It is a scenario that I did not test. I assumed that the data in table1 always existed in table2.


But it's a small change in the macro.
Change this line:

a(i, j) = b(fil2, col2)

By this line:

If fil2 > 0 Then a(i, j) = b(fil2, col2)

--------------
Please, try your scenarios again, if there is one in particular, come back here, put the data with which you are testing, so I can review it and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

I am very new to the more advanced parts of vba (this is advanced to me) and I just spend a few hours running the code line by line and googling what all this does and I am very impressed and actually learned a ton from this. So thanks a lot again this really helped me

Regarda,
Bassie