Filtering different brands of items into new sheet

[alvin97]

I needs help on with filter different brand of item, as current VBA code was all using range cell to filter into different column. This make a lot of code needed to amend when there is a new product. Is there a way to filter each brand with unique SKU like (BrandA, BrandB, BrandC)? Thanks

Before

After

Sub Report()

Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Main"

Dim ResultCell As Range
Dim Sheet As Worksheet

Set Sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
Sheet.Name = "Report"

Sheets("Main").Range("$A$4:$A$21").Copy
Sheets("Report").Activate
Range("A4").Select
ActiveSheet.Paste

Sheets("Main").Range("$A$22:$A$35").Copy
Sheets("Report").Activate
Range("D4").Select
ActiveSheet.Paste

Sheets("Main").Range("$A$36:$A$45").Copy
Sheets("Report").Activate
Range("G4").Select
ActiveSheet.Paste


    Dim LookupValueCell As Range
    Dim LookupVector As Range
    Dim ResultVector As Range

    
    Set ResultCell = Sheets("Report").Range("$B$4:$B$21")
    Set LookupValueCell = Sheets("Report").Range("$A$4:$A$400")
    Set LookupVector = Sheets("Main").Range("$A$4:$A$400")
    Set ResultVector = Sheets("Main").Range("$B$4:$B$23")

ResultCell = WorksheetFunction.Lookup(LookupValueCell, LookupVector, ResultVector)

    Dim LookupValueCell1 As Range
    Dim LookupVector1 As Range
    Dim ResultVector1 As Range
    Dim ResultCell1 As Range
    
    
    Set ResultCell1 = Sheets("Report").Range("$E$4:$E$17")
    Set LookupValueCell1 = Sheets("Report").Range("$D$4:$D$400")
    Set LookupVector1 = Sheets("Main").Range("$A$4:$A$400")
    Set ResultVector1 = Sheets("Main").Range("$B$4:$B$372")

ResultCell1 = WorksheetFunction.Lookup(LookupValueCell1, LookupVector1, ResultVector1)

    Dim LookupValueCell2 As Range
    Dim LookupVector2 As Range
    Dim ResultVector2 As Range
    Dim ResultCell2 As Range
    
    
    Set ResultCell2 = Sheets("Report").Range("$H$4:$H$13")
    Set LookupValueCell2 = Sheets("Report").Range("$G$4:$H$400")
    Set LookupVector2 = Sheets("Main").Range("$A$4:$A$400")
    Set ResultVector2 = Sheets("Main").Range("$B$4:$B$372")

ResultCell2 = WorksheetFunction.Lookup(LookupValueCell2, LookupVector2, ResultVector2)
 
DateString = Format(Now, "DDMMMYYYY")
[B1].Value = DateString
End Sub

 

[HighAndWilder]

I needs help on with filter different brand of item, as current VBA code was all using range cell to filter into different column. This make a lot of code needed to amend when there is a new product. Is there a way to filter each brand with unique SKU like (BrandA, BrandB, BrandC)? Thanks

Before
View attachment 117335
After
View attachment 117337

Sub Report()

Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Main"

Dim ResultCell As Range
Dim Sheet As Worksheet

Set Sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
Sheet.Name = "Report"

Sheets("Main").Range("$A$4:$A$21").Copy
Sheets("Report").Activate
Range("A4").Select
ActiveSheet.Paste

Sheets("Main").Range("$A$22:$A$35").Copy
Sheets("Report").Activate
Range("D4").Select
ActiveSheet.Paste

Sheets("Main").Range("$A$36:$A$45").Copy
Sheets("Report").Activate
Range("G4").Select
ActiveSheet.Paste


    Dim LookupValueCell As Range
    Dim LookupVector As Range
    Dim ResultVector As Range

   
    Set ResultCell = Sheets("Report").Range("$B$4:$B$21")
    Set LookupValueCell = Sheets("Report").Range("$A$4:$A$400")
    Set LookupVector = Sheets("Main").Range("$A$4:$A$400")
    Set ResultVector = Sheets("Main").Range("$B$4:$B$23")

ResultCell = WorksheetFunction.Lookup(LookupValueCell, LookupVector, ResultVector)

    Dim LookupValueCell1 As Range
    Dim LookupVector1 As Range
    Dim ResultVector1 As Range
    Dim ResultCell1 As Range
   
   
    Set ResultCell1 = Sheets("Report").Range("$E$4:$E$17")
    Set LookupValueCell1 = Sheets("Report").Range("$D$4:$D$400")
    Set LookupVector1 = Sheets("Main").Range("$A$4:$A$400")
    Set ResultVector1 = Sheets("Main").Range("$B$4:$B$372")

ResultCell1 = WorksheetFunction.Lookup(LookupValueCell1, LookupVector1, ResultVector1)

    Dim LookupValueCell2 As Range
    Dim LookupVector2 As Range
    Dim ResultVector2 As Range
    Dim ResultCell2 As Range
   
   
    Set ResultCell2 = Sheets("Report").Range("$H$4:$H$13")
    Set LookupValueCell2 = Sheets("Report").Range("$G$4:$H$400")
    Set LookupVector2 = Sheets("Main").Range("$A$4:$A$400")
    Set ResultVector2 = Sheets("Main").Range("$B$4:$B$372")

ResultCell2 = WorksheetFunction.Lookup(LookupValueCell2, LookupVector2, ResultVector2)
 
DateString = Format(Now, "DDMMMYYYY")
[B1].Value = DateString
End Sub

Try this:

Do you have more then two columns on the Main worksheet?

Public Sub subFilterBrands()
Dim arrBrands() As Variant
Dim i As Integer
Dim rngData As Range
Dim WsReport As Worksheet
Dim WsMain As Worksheet
Dim Wb As Workbook
Dim Q As String

  ActiveWorkbook.Save
  
  Set Wb = ActiveWorkbook
  
  Q = Chr(34)
    
  Set WsMain = Wb.Sheets("Main")
  
  Application.DisplayAlerts = False
  On Error Resume Next
  Wb.Worksheets("Report").Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
  
  Set WsReport = ActiveWorkbook.Sheets.Add(After:=Wb.Sheets(Wb.Sheets.Count))

  WsReport.Name = "Report"
  
  With WsMain.Range("A1").CurrentRegion
  
    With .Offset(1, 0).Resize(.Rows.Count, 2)
    
      arrBrands = Evaluate("SORT(UNIQUE(" & WsMain.Name & "!" & .Columns(1).Address & "),1)")
    
      For i = LBound(arrBrands) To UBound(arrBrands) - 1
            
        WsReport.Range("A4").Offset(0, (i - 1) * 3).Formula2 = "=FILTER(" & WsMain.Name & "!" & .Address & "," & WsMain.Name & "!" & .Columns(1).Address & "=" & Q & arrBrands(i, 1) & Q & ","""")"
     
      Next i
  
    End With
    
  End With
  
  With WsReport
    .UsedRange.Value = WsReport.UsedRange.Value
    .Cells.EntireColumn.AutoFit
  End With
  
End Sub

 

[alvin97]

Try this:

Do you have more then two columns on the Main worksheet?

Public Sub subFilterBrands()
Dim arrBrands() As Variant
Dim i As Integer
Dim rngData As Range
Dim WsReport As Worksheet
Dim WsMain As Worksheet
Dim Wb As Workbook
Dim Q As String

  ActiveWorkbook.Save
 
  Set Wb = ActiveWorkbook
 
  Q = Chr(34)
   
  Set WsMain = Wb.Sheets("Main")
 
  Application.DisplayAlerts = False
  On Error Resume Next
  Wb.Worksheets("Report").Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
 
  Set WsReport = ActiveWorkbook.Sheets.Add(After:=Wb.Sheets(Wb.Sheets.Count))

  WsReport.Name = "Report"
 
  With WsMain.Range("A1").CurrentRegion
 
    With .Offset(1, 0).Resize(.Rows.Count, 2)
   
      arrBrands = Evaluate("SORT(UNIQUE(" & WsMain.Name & "!" & .Columns(1).Address & "),1)")
   
      For i = LBound(arrBrands) To UBound(arrBrands) - 1
           
        WsReport.Range("A4").Offset(0, (i - 1) * 3).Formula2 = "=FILTER(" & WsMain.Name & "!" & .Address & "," & WsMain.Name & "!" & .Columns(1).Address & "=" & Q & arrBrands(i, 1) & Q & ","""")"
    
      Next i
 
    End With
   
  End With
 
  With WsReport
    .UsedRange.Value = WsReport.UsedRange.Value
    .Cells.EntireColumn.AutoFit
  End With
 
End Sub

Yes, I do have more than 2 columns in my main worksheet (this 2 data was in column A & column M), as for report only need this 2 column information. thanks

 

[HighAndWilder]

Yes, I do have more than 2 columns in my main worksheet (this 2 data was in column A & column M), as for report only need this 2 column information. thanks

This code will take columns 1 and 13, A and M and use those for the report.

Are you able to use XL2BB Add-In to post code and example data next time. It helps developers considerably.

Public Sub subFilterBrands()
Dim arrBrands() As Variant
Dim i As Integer
Dim rngData As Range
Dim WsReport As Worksheet
Dim WsMain As Worksheet
Dim Wb As Workbook
Dim Q As String
Dim strFormula As String

  ActiveWorkbook.Save
  
  Set Wb = ActiveWorkbook
  
  Q = Chr(34)
    
  Set WsMain = Wb.Sheets("Main")
    
  Application.DisplayAlerts = False
  On Error Resume Next
  Wb.Worksheets("Report").Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
  
  Set WsReport = ActiveWorkbook.Sheets.Add(After:=Wb.Sheets(Wb.Sheets.Count))

  WsReport.Name = "Report"
  
  With WsMain.Range("A1").CurrentRegion
  
    With .Offset(1, 0).Resize(.Rows.Count, 13)
    
      arrBrands = Evaluate("SORT(UNIQUE(" & WsMain.Name & "!" & .Columns(1).Address & "),1)")
    
      For i = LBound(arrBrands) To UBound(arrBrands) - 1
      
        strFormula = "=CHOOSECOLS(FILTER(" & WsMain.Name & "!" & .Address & "," & WsMain.Name & "!" & .Columns(1).Address & "=" & Q & arrBrands(i, 1) & Q & ",""""),1,13)"
  
        WsReport.Range("A4").Offset(0, (i - 1) * 3).Formula2 = strFormula
    
      Next i
  
    End With
    
  End With
  
  With WsReport
    .UsedRange.Value = WsReport.UsedRange.Value
    .Cells.EntireColumn.AutoFit
  End With
  
End Sub

 

[alvin97]

Try this:

Do you have more then two columns on the Main worksheet?

Public Sub subFilterBrands()
Dim arrBrands() As Variant
Dim i As Integer
Dim rngData As Range
Dim WsReport As Worksheet
Dim WsMain As Worksheet
Dim Wb As Workbook
Dim Q As String

  ActiveWorkbook.Save
 
  Set Wb = ActiveWorkbook
 
  Q = Chr(34)
   
  Set WsMain = Wb.Sheets("Main")
 
  Application.DisplayAlerts = False
  On Error Resume Next
  Wb.Worksheets("Report").Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
 
  Set WsReport = ActiveWorkbook.Sheets.Add(After:=Wb.Sheets(Wb.Sheets.Count))

  WsReport.Name = "Report"
 
  With WsMain.Range("A1").CurrentRegion
 
    With .Offset(1, 0).Resize(.Rows.Count, 2)
   
      arrBrands = Evaluate("SORT(UNIQUE(" & WsMain.Name & "!" & .Columns(1).Address & "),1)")
   
      For i = LBound(arrBrands) To UBound(arrBrands) - 1
           
        WsReport.Range("A4").Offset(0, (i - 1) * 3).Formula2 = "=FILTER(" & WsMain.Name & "!" & .Address & "," & WsMain.Name & "!" & .Columns(1).Address & "=" & Q & arrBrands(i, 1) & Q & ","""")"
    
      Next i
 
    End With
   
  End With
 
  With WsReport
    .UsedRange.Value = WsReport.UsedRange.Value
    .Cells.EntireColumn.AutoFit
  End With
 
End Sub

I have try your code, which this cause every single product on each column. Sorry i unable to show my main product info due to contain sensitive information.

This is a example of my product info.
sku: BrandA004
BrandA is my brand ID (unique)
004 is my product ID (not Unique)

 

[HighAndWilder]

I have try your code, which this cause every single product on each column. Sorry i unable to show my main product info due to contain sensitive information.

This is a example of my product info.
sku: BrandA004
BrandA is my brand ID (unique)
004 is my product ID (not Unique)
View attachment 117346

So what do you want in the first column of each set of data on the Report sheet?

Do you want it to filter on the Alpha characters e.g. BrandB or the Numeric characters e.g. 001?

 

[alvin97]

So what do you want in the first column of each set of data on the Report sheet?

Do you want it to filter on the Alpha characters e.g. BrandB or the Numeric characters e.g. 001?

This was what i want for the outcome

 

[alvin97]

This was what i want for the outcome

Brand A 2 column
Brand B 2 column
Brand C 2 column

 

[HighAndWilder]

This was what i want for the outcome

But what do you want to see in the column?

 

[alvin97]

So what do you want in the first column of each set of data on the Report sheet?

Do you want it to filter on the Alpha characters e.g. BrandB or the Numeric characters e.g. 001?

yes filter on the Alpha characters BrandB. Thanks