vba code for index match

akbarnikain · Feb 23rd 2017

Category Fruits FruitsPrice Vegetables VegPrice Dairy DairyPrice

Fruits Apple $1.25 Tomato $0.99 Butter $3.45
FruitsPrice Grape $2.00 Potato $1.45 Cheese $4.75
Vegetables Pears $1.75 Onion $1.10 Milk $3.55
VegPrice Cucumber $0.75
Dairy
DairyPrice

I have the above table and 2 combo boxes; representing criteria 1) for "Category" (ROWS) and 2) for the "Items" under those categories (COLUMNS) and based on the 2 criteria in the ComboBoxes I would like to display the price in a TextBox using INDEX and MATCH if possible .
My vba code for the "textbox1" is:

Code

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Set ws = Sheets("catitem")
ws.Select
MsgBox "The category in ComboBox1 is... " & Me.ComboBox1.Value & vbNewLine & _
"The item in ComboBox2 is... " & Me.ComboBox2.Value & vbNewLine & _
"The DATA RANGE is... " & Range("rng").Address & vbNewLine & _
"The HEADINGS range is... " & Range("items").Address
If ComboBox1 = "" Or ComboBox2 = "" Then
Exit Sub
End If
With Application.WorksheetFunction
TextBox1 = .Index(Range("rng"), _
.Match(Me.ComboBox1.Value, Range("items"), 0), _
.Match(Me.ComboBox2.Value, Range("rng"), 0)).Offset(, 1)




TextBox1.Value = Format(TextBox1, "$#,##0.00")
End With




End Sub

Display More

The above code obviously does not work
Can someone help me with the vba code. Thanks

The rest of my code is:

Code

Public ws As Worksheet, resp, cat, fruit, veg, bev, soap, title, listItem, catCol As String, nRow, iCnt, col As Integer, rng As Range, rate As Variant




Option Explicit




Private Sub ComboBox2_DropButtonClick()
With ComboBox2




.RowSource = Me.ComboBox1.Value
End With
Sheets("catitem").Select
With Application.WorksheetFunction
End With
End Sub




Private Sub ComboBox3_Change()
Set ws = Sheets("catitem")
ws.Select
With ComboBox3
Select Case ComboBox3
Case Is = Range("b1")
title = Range("b1").Value
ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("fruits").RefersToRange)




Case Is = Range("c1")
title = Range("c1").Value




ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("vegetables").RefersToRange)




Case Is = Range("d1")
title = Range("d1").Value
ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("soaps").RefersToRange)




Case Is = Range("e1")
title = Range("e1").Value
ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("beverages").RefersToRange)




Case Is = Range("f1")
title = Range("f1").Value
'MsgBox title
ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("dairy").RefersToRange)




Case Is = Range("g1")
title = Range("g1").Value
ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("pharmacy").RefersToRange)




Case Is = Range("h1")
title = Range("h1").Value
ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("stationeries").RefersToRange)
End Select
End With
End Sub




Private Sub CommandButton1_Click()
Set ws = Sheets("catitem")
ws.Select
ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("category").RefersToRange)
nRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
MsgBox "The NEXT EMPTY ROW is..." & nRow




Do
nRow = Cells(Rows.Count, 1).End(xlUp).Row + 1




cat = Application.InputBox(prompt:="Enter a NEW CATEGORY...")
resp = MsgBox("Do you want to ADD this CATEGORY?", vbYesNo)
If resp = vbYes Then
Cells(nRow, 1) = cat
ListBox1.ListIndex = ListBox1.ListIndex
ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("category").RefersToRange)




End If
resp = MsgBox("Do you want to CONTINUE...?", vbYesNo)
Loop While resp = vbYes
Columns.AutoFit
End Sub




Private Sub ComboBox1_Change()
On Error Resume Next
Set ws = Sheets("catitem")
ws.Select
Select Case ComboBox1




Case Is = Range("b1")
ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("fruits").RefersToRange)
Case Is = Range("c1")
ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("vegetables").RefersToRange)
Case Is = Range("d1")
ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("beverages").RefersToRange)
Case Is = Range("e1")
ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("soaps").RefersToRange)
Case Is = Range("f1")
ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("dairy").RefersToRange)
Case Is = Range("g1")
ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("pharmacy").RefersToRange)
Case Is = Range("h1")
ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("stationeries").RefersToRange)
End Select
ComboBox2.RowSource = Me.ComboBox1.Value
End Sub




Sub addItem()
Do
MsgBox "The column number is..." & col
nRow = Cells(Rows.Count, Val(col)).End(xlUp).Row + 1
MsgBox "The next empty ROW is..." & nRow
item = Application.InputBox(prompt:="Enter a new item...")




resp = MsgBox("Do you want to ADD this ITEM?", vbYesNo)
If resp = vbYes Then
'Do




Cells(nRow, col) = item
ListBox1.ListIndex = ListBox1.ListIndex
ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names(title).RefersToRange)
End If
resp = MsgBox("Do you want to CONTINUE...?", vbYesNo)
Loop While resp = vbYes
Columns.AutoFit
End Sub




Private Sub CommandButton3_Click()
Unload Me
Range("b2").Select
End Sub




Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With ListBox1
.RowSource = ComboBox3.Value
End With
End Sub

Display More

**pike** · Feb 24th 2017

Re: vba code for index match

hello possibly easier if can post a workbook

akbarnikain · Feb 25th 2017

Re: vba code for index match

Attached is the workbook
Thanks

**pike** · Feb 25th 2017

Re: vba code for index match

Hi akbarnikain,

Not a good idea to use the source row in VBA
made some changes to the userform syntax

Code

Public ws As Worksheet, resp, cat, fruit, veg, bev, soap, title, listItem, catCol As String, nRow, iCnt, col As Integer, rng As Range, rate As Variant


Option Explicit


Private Sub ComboBox2_Change()
    On Error Resume Next
    Set rng = Range(ComboBox1.Value)
    On Error GoTo 0
    If Not rng Is Nothing Then
        If Not ComboBox2 = vbNullString Then
            With Application.WorksheetFunction
                TextBox1 = .Index(Range(ComboBox1.Value).Offset(0, 1), .Match(ComboBox2, Range(ComboBox1.Value), 0))
                TextBox1.Value = Format(TextBox1, "$#,##0.00")
            End With
        End If
    End If
End Sub
Private Sub ComboBox2_DropButtonClick()
    With ComboBox2
        '.RowSource = Me.ComboBox1.Value
    End With
    Sheets("catitem").Select
    With Application.WorksheetFunction
    End With
End Sub


Private Sub ComboBox3_Change()
    Set ws = Sheets("catitem")
    ws.Select
    With ComboBox3
        Select Case ComboBox3
        Case Is = Range("b1")
            title = Range("b1").Value
            ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("fruits").RefersToRange)


        Case Is = Range("c1")
            title = Range("c1").Value


            ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("vegetables").RefersToRange)


        Case Is = Range("d1")
            title = Range("d1").Value
            ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("soaps").RefersToRange)


        Case Is = Range("e1")
            title = Range("e1").Value
            ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("beverages").RefersToRange)


        Case Is = Range("f1")
            title = Range("f1").Value
            'MsgBox title
            ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("dairy").RefersToRange)


        Case Is = Range("g1")
            title = Range("g1").Value
            ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("pharmacy").RefersToRange)


        Case Is = Range("h1")
            title = Range("h1").Value
            ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("stationeries").RefersToRange)
        End Select
    End With
End Sub


Private Sub CommandButton1_Click()
    Set ws = Sheets("catitem")
    ws.Select
    ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("category").RefersToRange)
    nRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    MsgBox "The NEXT EMPTY ROW is..." & nRow


    Do
        nRow = Cells(Rows.Count, 1).End(xlUp).Row + 1


        cat = Application.InputBox(prompt:="Enter a NEW CATEGORY...")
        resp = MsgBox("Do you want to ADD this CATEGORY?", vbYesNo)
        If resp = vbYes Then
            Cells(nRow, 1) = cat
            ListBox1.ListIndex = ListBox1.ListIndex
            ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("category").RefersToRange)


        End If
        resp = MsgBox("Do you want to CONTINUE...?", vbYesNo)
    Loop While resp = vbYes
    Columns.AutoFit
End Sub


Private Sub ComboBox1_Change()
    On Error Resume Next
    Me.ComboBox2.Clear
    Me.ComboBox3.Clear
    Me.TextBox1.Value = vbNullString
    Me.ComboBox2.List = Application.Transpose(Range(Me.ComboBox1.Value))
    'Set ws = Sheets("catitem")
    'ws.Select
    'Select Case ComboBox1


    'Case Is = Range("b1")
    'ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("fruits").RefersToRange)
    'Case Is = Range("c1")
    'ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("vegetables").RefersToRange)
    'Case Is = Range("d1")
    'ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("beverages").RefersToRange)
    'Case Is = Range("e1")
    'ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("soaps").RefersToRange)
    'Case Is = Range("f1")
    'ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("dairy").RefersToRange)
    'Case Is = Range("g1")
    'ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("pharmacy").RefersToRange)
    'Case Is = Range("h1")
    'ComboBox2.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names("stationeries").RefersToRange)
    'End Select
    'ComboBox2.RowSource = Me.ComboBox1.Value
End Sub


Sub addItem()
    Do
        MsgBox "The column number is..." & col
        nRow = Cells(Rows.Count, Val(col)).End(xlUp).Row + 1
        MsgBox "The next empty ROW is..." & nRow
        item = Application.InputBox(prompt:="Enter a new item...")


        resp = MsgBox("Do you want to ADD this ITEM?", vbYesNo)
        If resp = vbYes Then
            Do


            Cells(nRow, col) = item
            ListBox1.ListIndex = ListBox1.ListIndex
            ListBox1.List = Application.WorksheetFunction.Transpose(ThisWorkbook.Names(title).RefersToRange)
        End If
        resp = MsgBox("Do you want to CONTINUE...?", vbYesNo)
    Loop While resp = vbYes
    Columns.AutoFit
End Sub


Private Sub CommandButton3_Click()
    Unload Me
    Range("b2").Select
End Sub


Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With ListBox1
        '.RowSource = ComboBox3.Value
    End With
End Sub
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Set ws = Sheets("catitem")
    ws.Select
    MsgBox "The category in ComboBox1 is... " & Me.ComboBox1.Value & vbNewLine & _
           "The item in ComboBox2 is... " & Me.ComboBox2.Value & vbNewLine & _
           "The DATA RANGE is... " & Range("rng").Address & vbNewLine & _
           "The HEADINGS range is... " & Range("items").Address
    If ComboBox1 = "" Or ComboBox2 = "" Then
        Exit Sub
    End If
    'With Application.WorksheetFunction
    'TextBox1 = .Index(Range("e3:e10"), .Match(ComboBox2, Range("vegetables"), 0))
    'TextBox1.Value = Format(TextBox1, "$#,##0.00")
    'End With


End Sub

Display More

akbarnikain · Feb 25th 2017

Re: vba code for index match

Thank you very much.

I would appreciate your help for the "Add Category" (CommandButton1) and "Add Items" (CommandButton2) to be able to add "dynamically" items to the respective columns based on the "Category" in "Column-A"
This would include when I ADD a new "Category/Item/Rate".
Thanks

**pike** · Feb 25th 2017

Re: vba code for index match

Hi,
The layout isn't helpful
RoyUK has a freebie that has the correct layout for a spreadsheet
http://www.excel-it.com/excel_databaseform.html

the add item to a category is doable but you have use a named range for the Category

if the data layout is like in RoyUK example the data is easily manipulated

**pike** · Feb 25th 2017

Re: vba code for index match

hello,
with your layout and removing all rowsource references from combobox's

Code

Option Explicit
Private Sub ComboBox2_Change()
    Dim strFind As String
    Dim rgnSearch As Range
    Dim rngFound As Range
    If Not ComboBox2 = vbNullString Then
        Set rgnSearch = Range(Cells(3, (ComboBox1.ListIndex * 2) + 2), Cells(Rows.Count, (ComboBox1.ListIndex * 2) + 2).End(xlUp))
        strFind = Me.ComboBox2.Value
        With rgnSearch
            Set rngFound = .Find(strFind, LookIn:=xlValues)
            If Not rngFound Is Nothing Then
                With Me.TextBox1
                     .Value = Format(rngFound.Offset(0, 1).Value, "$#,##0.00")
                End With
            End If
    End With
         End If
End Sub
Private Sub CommandButton1_Click()
If Not Me.TextBox5 = vbNullString Then
    Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Resize(1, 2) = VBA.Array(Me.TextBox5.Value, Me.TextBox5.Value & "Rate")
End If
End Sub
Private Sub ComboBox1_Change()
    Me.ComboBox2.Clear
    Me.TextBox1.Value = vbNullString
    If ComboBox1.ListIndex > 0 Then
         With Me.ComboBox2
            .List = Application.Transpose(Range(Cells(3, (ComboBox1.ListIndex * 2) + 2), Cells(Rows.Count, (ComboBox1.ListIndex * 2) + 2).End(xlUp)))
        End With
    End If
End Sub
Private Sub CommandButton2_Click()
       If Not Me.TextBox3.Value = vbNullString And Not Me.TextBox4.Value = vbNullString Then
            Cells(Rows.Count, (ComboBox3.ListIndex * 2) + 2).End(xlUp).Offset(1, 0).Resize(1, 2) = VBA.Array(Me.TextBox3.Value, Me.TextBox4.Value)
        End If
End Sub
Private Sub CommandButton3_Click()
    Unload Me
    Range("b2").Select
End Sub
Private Sub UserForm_Initialize()
    Dim lngCatCol As Long
    With ComboBox1
        For lngCatCol = 2 To Cells(2, Columns.Count).End(xlToLeft).Column Step 2
            .addItem Cells(2, lngCatCol).Value
        Next
    End With
     With ComboBox3
        For lngCatCol = 2 To Cells(2, Columns.Count).End(xlToLeft).Column Step 2
            .addItem Cells(2, lngCatCol).Value
        Next
    End With
End Sub

Display More

akbarnikain · Feb 26th 2017

Re: vba code for index match

Thanks again for all your help....you have been prompt and just great!

**pike** · Feb 26th 2017

Re: vba code for index match

removed a few bugs..try...

Code

Option Explicit
Private Sub ComboBox2_Change()
    Dim strFind As String
    Dim rgnSearch As Range
    Dim rngFound As Range
    If Not ComboBox2 = vbNullString Then
        Set rgnSearch = Range(Cells(3, (ComboBox1.ListIndex * 2) + 2), Cells(Rows.Count, (ComboBox1.ListIndex * 2) + 2).End(xlUp))
        strFind = Me.ComboBox2.Value
        With rgnSearch
            Set rngFound = .Find(strFind, LookIn:=xlValues)
            If Not rngFound Is Nothing Then
                With Me.TextBox1
                    .Value = Format(rngFound.Offset(0, 1).Value, "$#,##0.00")
                End With
            End If
        End With
    End If
End Sub


Private Sub CommandButton1_Click()
    If Not Me.TextBox5 = vbNullString Then
        Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Resize(1, 2) = VBA.Array(Me.TextBox5.Value, Me.TextBox5.Value & "Rate")
    End If
    Me.TextBox5 = vbNullString
    Call Refresh_ComboBox
End Sub


Private Sub ComboBox1_Change()
    Me.ComboBox2.Clear
    Me.TextBox1.Value = vbNullString
    If ComboBox1.ListIndex > -1 Then
        With Me.ComboBox2
            If Cells(Rows.Count, (ComboBox1.ListIndex * 2) + 2).End(xlUp).Row > 3 Then
                .List = Application.Transpose(Range(Cells(3, (ComboBox1.ListIndex * 2) + 2), Cells(Rows.Count, (ComboBox1.ListIndex * 2) + 2).End(xlUp)))
            Else
                .addItem Cells(3, (ComboBox1.ListIndex * 2) + 2).Value
            End If
        End With
    End If
End Sub


Private Sub CommandButton2_Click()
    If Not Me.TextBox3.Value = vbNullString And Not Me.TextBox4.Value = vbNullString Then
        Cells(Rows.Count, (ComboBox3.ListIndex * 2) + 2).End(xlUp).Offset(1, 0).Resize(1, 2) = VBA.Array(Me.TextBox3.Value, Me.TextBox4.Value)
    End If
    Me.TextBox3.Value = vbNullString
    Me.TextBox4.Value = vbNullString
    Call Refresh_ComboBox
End Sub


Private Sub CommandButton3_Click()
    Unload Me
End Sub


Private Sub UserForm_Initialize()
    Me.Caption = "Super Market Application"
    Call Refresh_ComboBox
End Sub


Sub Refresh_ComboBox()
    Dim lngCatCol As Long
    With ComboBox1
        .Clear
        For lngCatCol = 2 To Cells(2, Columns.Count).End(xlToLeft).Column Step 2
            .addItem Cells(2, lngCatCol).Value
        Next
        .ListIndex = 0
    End With
    With ComboBox3
        .Clear
        For lngCatCol = 2 To Cells(2, Columns.Count).End(xlToLeft).Column Step 2
            .addItem Cells(2, lngCatCol).Value
        Next
    End With
    Me.ComboBox2.Clear
    If ComboBox1.ListIndex > -1 Then
        With Me.ComboBox2
            If Cells(Rows.Count, (ComboBox1.ListIndex * 2) + 2).End(xlUp).Row > 3 Then
                .List = Application.Transpose(Range(Cells(3, (ComboBox1.ListIndex * 2) + 2), Cells(Rows.Count, (ComboBox1.ListIndex * 2) + 2).End(xlUp)))
            Else
                .addItem Cells(3, (ComboBox1.ListIndex * 2) + 2).Value
            End If
        End With
    End If
End Sub

Display More

akbarnikain · Feb 27th 2017

Re: vba code for index match

Sorry to bother you...when Adding ("CommandButton2") a new Category ("combobox3"), new Item/Price ("TextBox3/4") it writes to the last empty row of the "whole table" rather than the first empty row for that new ("Category") column heading...also the same when adding new "items" to existing "categories". Can you help?
Thanks

**pike** · Feb 27th 2017

Re: vba code for index match

no bother

Code

Private Sub CommandButton2_Click()
    Dim lngRow
    If Not Me.TextBox3.Value = vbNullString And Not Me.TextBox4.Value = vbNullString Then
        For lngRow = 3 To Cells(Rows.Count, (ComboBox3.ListIndex * 2) + 2).End(xlUp).Row + 1
            If Cells(lngRow, (ComboBox3.ListIndex * 2) + 2).Value = vbNullString Then
                Cells(lngRow, (ComboBox3.ListIndex * 2) + 2).Resize(1, 2) = VBA.Array(Me.TextBox3.Value, Me.TextBox4.Value)
                Exit For
            End If
        Next
    End If
    Me.TextBox3.Value = vbNullString
    Me.TextBox4.Value = vbNullString
    Call Refresh_ComboBox
End Sub

Display More

and

Code

Private Sub CommandButton1_Click()
    Dim lngCol As Long
    If Not Me.TextBox5 = vbNullString Then
        For lngCol = 2 To Cells(2, Columns.Count).End(xlToLeft).Column + 2 Step 2
            If Cells(2, lngCol).Value = vbNullString Then
                Cells(2, lngCol).Resize(1, 2) = VBA.Array(Me.TextBox5.Value, Me.TextBox5.Value & "Rate")
                Exit For
            End If
        Next
    End If
    Me.TextBox5 = vbNullString
    Call Refresh_ComboBox
End Sub

Display More

you should add some edit buttons

akbarnikain · Feb 28th 2017

Re: vba code for index match

Not sure if you received my last email...I am sending it again.

Sorry to bother you...when Adding ("CommandButton2") a new Category ("combobox3"), new Item/Price ("TextBox3/4") it writes to the last empty row of the "whole table" rather than the first empty row for that new ("Category") column heading...Can you help?
Thanks

**pike** · Mar 1st 2017

Re: vba code for index match

Hello,
No I didn't miss it. The code for the two command buttons are in post #11

vba code for index match

Participate now!

Share