autofilter with array of values and multiple criteria

hi.,

I have column with multiple unique values (which will be dynamic, not standard, as the user might enter different values) like following.

Offwhite - 21091 HGL

Off White - Off White

Offwhite - 10858 SF

10858 SF - 10858 SF

WPC.

ex: finish code1 (off white) - finish code2 (21091 HGL)

finish code2 (21091 HGL) - finish code2 (21091 HGL)

finish code1 (off white) - finish code3 (10858 SF)

finish code3 (10858 SF) - finish code3 (10858 SF)

I would like to filter out as separate ( finishcode1 & finish code2, finish code2 & finish code)

Offwhite - 21091 HGL

Off White - Off White

and the following as separately.

Offwhite - 10858 SF

10858 SF - 10858 SF

and WPC as separately.

The current code filters, copy the filtered value, creates new sheet and paste the values for the each value in the array of values.

How to find solution for the above scenario.

' Segregating the values from rows in seperate sheet with lookup in column with more than 30 Characters

Sub Splitdatabycol()
' declaring the variable for the last row
Dim lr As Long
' declaring the variable for the Source worksheet
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
' declaring the variable for the Top Header
Dim xTRg As Range
' declaring the variable for the Vertical Column
Dim xVRg As Range
Dim xWSTRg As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
' Type:= 8, A cell reference, as a Range object
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
'Returns the column no of the selected column
vcol = xVRg.Column

Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
Dim sheetName As String
For i = 2 To UBound(myarr)
'"=*" & myarr(i) & "*", Operator:=xlAnd
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
' Replace the below assignment to sheetName as you wish
sheetName = Left(CStr(i - 1) & "_" & myarr(i), 30)
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = sheetName
Else
Sheets(sheetName).Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(sheetName).Range("A1")
Sheets(sheetName).Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
On Error Resume Next
ActiveSheet.ShowAllData

End Sub

sample.xlsx

Carim

could you check this out pls

Hi Carim,

Thanks for the help. will tryout as advised.

little bit brief.

Concept: the panel will be pasted by laminates on both sides ( either same laminates or two different laminates).

if both laminates (i.e color (21091 HGL -21091 HGL) (except off white - off white combination) are same or the one laminate is of color with combination of Off white( I.e 21091 HGL - Off white),both are grouped in the same new sheet.

Like that each unique color ( 10858 SF - 10858 SF) & (10858 SF - OFF WHITE) has to be grouped in the new sheet.

off white - off white combination alone grouped in another new sheet.

Like this output i am looking out.

Basically the unique color to be grouped together. (21091 - 21091 & 21091 - offwhite)

for that i am trying to access the my array variable, convert to text to column, get the unique values, and autofilter based on the unique values and copy them to the sheet. is it correct way to do that?

.

hi Carim.,

Thanks!.

Attached here with the excel file with the details.

manually we are doing as filter, text filter of 21091 HGL , so it filters out the 21091 HGL- 21091 HGL & Offwhite - 21091 HGL Categories. Then it has been copied to next sheets.

Like wise - 10858 SF

the code will be varies for each project, hence it has to be accessed from the array of Column Value, which has choosen,

Hi.,

The five groups corresponds to the Column F and not I & J. If you filter Column F as per the image, you can get the groupings.

I & J i had indicated the name of the laminates. These laminates combine together form a group. Like (Laminate 01 & Laminate 02 ) or ( Laminate 2 & Laminate 02), etc.,

Hope it will be clear now..

Hi.

Thanks. The macro filters out based on the Column G, i.e vcol = 7.

Yes, i am looking for the formula to create the groups in the column F.

thanks.

Hi.,

Thanks for your time and patience.

Pls find the attached image. Both sheets values to be combined together as a combined sheet.

as a last resort, could able to help out..

Hi again!.

Thanks. Works as intended. will try to make the Worksheet "Type" and the formula to be filled as dynamic . Thanks again for your patience and time spent to resolve.!

Sure. Thanks