Macro to filter values

dkool · Dec 1st 2022

Hello

I need an excel formula or Macro to do the following in my attached spreadsheet

1. In the input tab filter on each unique product in column A to identify possible combinations of product with each of the values in column B-D (see expected output tab).

2 . For each unique combination paste the values from column H in a separate tab.

3 . Do this for each product

I have attached the sample expected output in the expected output tab for product 1 but I will need to do the same for each unique product in my list.

Thanks in advance

query.xlsm

**Carim** · Dec 2nd 2022

Hello,

It seems to me you should be aiming for a two-step process ...

Step 1 : Explode Data from your input sheet into separate sheets ( which is a very common request ...)

Step 2 : Loop through your newly created sheets to produce all the possible combinations based on your 5-item-fixed List

Thanks for confirming

**KjBox** · Dec 2nd 2022

Do mean you need each Product to have combinations on a new sheet (in the case of your sample file that would be 3 new sheets)?

**KjBox** · Dec 2nd 2022

If that is what you mean the try the attached file. Click the button on the Input Sheet

Code assigned to the button

Code

Sub UniqueProductCombinations()
    Dim x, y, z, zz, e, i&, ii&, s$, oDic As Object
    Dim Hdrs, ws As Worksheet
    
    Set oDic = CreateObject("scripting.dictionary")
    
    With Sheet1
        x = .Cells(1, 1).CurrentRegion
        y = .Cells(1, 8).CurrentRegion
        ReDim Hdrs(1 To UBound(x, 2) + 1)
    End With
    With oDic
        For i = 2 To UBound(x, 1)
            For ii = 2 To UBound(y, 1)
                If Not .exists(x(i, 1) & x(i, 2) & y(ii, 1)) Then
                    .Add x(i, 1) & "_" & x(i, 2) & "_" & y(ii, 1), _
                    Array(x(i, 3), x(i, 4))
                End If
            Next
        Next
    End With
    i = 0
    ReDim z(1 To oDic.Count, 1 To UBound(x, 2) + 1)
    For Each e In oDic.keys
        i = i + 1
        z(i, 1) = Split(e, "_")(0): z(i, 2) = Split(e, "_")(1)
        z(i, 3) = oDic(e)(0): z(i, 4) = oDic(e)(1)
        z(i, 5) = Split(e, "_")(2)
    Next
    For i = 1 To UBound(Hdrs) - 1
        Hdrs(i) = x(1, i)
    Next
    Hdrs(UBound(Hdrs)) = y(1, 1)
    Application.ScreenUpdating = 0
    For i = 1 To UBound(z, 1)
        s = z(i, 1)
        ReDim zz(1 To oDic.Count, 1 To 5)
        Do Until z(i, 1) <> s
            For ii = 1 To UBound(z, 2)
                zz(i, ii) = z(i, ii)
            Next
            i = i + 1
            If i > UBound(z, 1) Then Exit Do
        Loop
        Set ws = Sheets.Add(, Sheets(Sheets.Count))
        With ActiveSheet
            .Name = "Product " & s
            .[a1].Resize(, UBound(Hdrs)) = Hdrs
            .[a2].Resize(UBound(zz, 1), UBound(zz, 2)) = zz
            On Error Resume Next
            .UsedRange.Columns(1).SpecialCells(4).EntireRow.Delete
            On Error GoTo 0
            .Columns.AutoFit
        End With
        i = i - 1
    Next
End Sub

Display More

dkool · Dec 2nd 2022

Hello . Thanks for this. This should work . Just one request , if the code can be made flexible. If I add more products in products column and more items to my fixed list , then currently it doesn't work . If that can be done that will be helpful

**KjBox** · Dec 2nd 2022

The code uses "CurrentRegion" for both the Input Products table and Fixed List so should work for any number of rows of either, but I will check.

**KjBox** · Dec 2nd 2022

Yes it does work, see attached

dkool · Dec 2nd 2022

works fine . Thank you

**KjBox** · Dec 2nd 2022

You're welcome

Macro to filter values

Carim Dec 2nd 2022

Participate now!

Share

Similar Threads

Looping trough all workbooks in a folder an their worksheet. Action is to paste special, so that there is no formula

Insert New Row if needed

Tags