0
votes

I am looking to search for different values (Commodity Group in range "FY", Sub Group in range "FZ", Product in Range "GA") on the same Worksheet based on 3 comboboxes - one for each of the items - and copy it to another Worksheet.

Note: It is not necessary to select all 3 comboboxes because Combobox2 is populated based on combobox1 and Combobox3 based on Combobox2. Moreover, the user Needs to be able to create a Portfolio based on Inputs from only 1 or 2 comboboxes. Also, if that makes a difference, the items in all 3 ranges on the Database-Worksheet may contain ( ) / , -

I cannot seem to get it working beyond the point that it looks for the item in the first Combobox.

Two pictures for Illustration-purposes:

http://imgur.com/a/FxeNh

http://imgur.com/a/KtqdU

Here my take on it - thank you all in advance:

Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws1, ws2, ws3 As Worksheet
Set ws1 = wb.Worksheets("Meta DB")
'ws2 not here
Set ws3 = wb.Worksheets("Supplier Criteria TreeView")

'1. - - get all Suppliers for the selected Input
Dim strFind As String
Dim strRange As String
Dim i, j, k As Long

'1.1. - - Get value to search for and range to go through (depending on combobox selections)
If Me.comboProduct.ListIndex = -1 And Me.comboSubGroup.ListIndex = -1 And Me.comboCG.ListIndex <> -1 Then
    strRange = "FY"
    strFind = Me.comboCG.value
ElseIf Me.comboProduct.ListIndex = -1 And Me.comboSubGroup.ListIndex <> -1 And Me.comboCG.ListIndex <> -1 Then
    strRange = "FZ"
    strFind = Me.comboSubGroup.value
ElseIf Me.comboProduct.ListIndex <> -1 And Me.comboSubGroup.ListIndex <> -1 And Me.comboCG.ListIndex <> -1 Then
    strRange = "GA"
    strFind = Me.comboProduct.value
End If

'Paste starting at row 2 or 30 in ws3, respectively (Active / Inactive)
j = 2
k = 30

'Start searching from row 4 of Database, continue to end of worksheet
For i = 4 To ws1.UsedRange.Rows.Count
    If ws1.Range(strRange & i) = strFind Then
        'Check for active Supplier
        If ws1.Range("E" & i) = "Yes" Then
            'Copy row i of Database to row j of ws3 then increment j
            ws1.Range("B" & i & ":" & "E" & i).Copy Destination:=ws3.Range("B" & j & ":" & "E" & j) 'Copy Name, Potential Supplier, ID, Active
            j = j + 1
        Else
            'If inactive Supplier, post further down from 30 onwards. Second listbox populates from there
            If ws1.Range("E" & i) = "No" Then
                ws1.Range("B" & i & ":" & "E" & i).Copy Destination:=ws3.Range("B" & k & ":" & "E" & k) 'Copy Name, Potential Supplier, ID, Active
                k = k + 1
            Else
                Exit Sub
            End If
        End If
    End If
Next i
1

1 Answers

0
votes
Private Sub cmdPortfolio_Click()
    Dim product As String, col As Variant
    Dim rw As Long, x As Long
    Dim c As Range, Target As Range

    '1.0. - - Clear previously used range
    Worksheets("Supplier Criteria TreeView").Range("A2:L28,A30:L100").Clear

    '1.1. - - Get value to search for and range to go through (depending on combobox selections)
    If Me.comboProduct.ListIndex = -1 And Me.comboSubGroup.ListIndex = -1 And Me.comboCG.ListIndex <> -1 Then
        col = "FY"
        product = Me.comboCG.Value
    ElseIf Me.comboProduct.ListIndex = -1 And Me.comboSubGroup.ListIndex <> -1 And Me.comboCG.ListIndex <> -1 Then
        col = "FZ"
        product = Me.comboSubGroup.Value
    ElseIf Me.comboProduct.ListIndex <> -1 And Me.comboSubGroup.ListIndex <> -1 And Me.comboCG.ListIndex <> -1 Then
        col = "GA"
        product = Me.comboProduct.Value
    End If

    With Worksheets("Meta DB")
        For x = 4 To .Cells(Rows.Count, col).End(xlUp).row
            If .Cells(x, col) = product Then
                rw = IIf(.Range("E" & x) = "Yes", 29, Rows.Count)
                Set Target = Worksheets("Supplier Criteria TreeView").Cells(rw, "B").End(xlUp).Offset(1)
                .Range("B" & x & ":" & "E" & x).Copy Destination:=Target

                With Target.EntireRow

                    Set c = Worksheets("Criteria").Range("K3", Worksheets("Criteria").Range("K" & Rows.Count).End(xlUp)).Find(.Cells(1, "D"))

                    If Not c Is Nothing Then

                        .Cells(1, "A") = Round(c.EntireRow.Cells(1, "L"))
                        .Cells(1, "F") = Round(c.EntireRow.Cells(1, "Q"))
                        .Cells(1, "G") = Round(c.EntireRow.Cells(1, "AG"))

                    End If

                End With

            End If
        Next
    End With

End Sub