Autofilter, copy, paste to new sheet VBA

[jersey111]

I am trying to write a VBA code that autofilters , copy and pastes to a new sheet. The names of the sheet will be soft medium hard where those values are found in column B. The problem is the cell that labels it as soft medium or hard has a bunch of filler characters before the designation. For example cell B2 may be 15488621-hard. Therefore I need to search each cell for its designation and copy the whole row to the proper sheet. I tried using the record macro for filter but it only allowed 2 criteria instead of 3. An additional problem that the spreadsheets I am working with contain 20,000+ cells so it needs to be relatively efficient at sorting. The number of rows in a given spreadsheet varies as well so I am not able to set a specific range. At this point I would assume it would be quicker to create the soft, med, hard sheets prior to sorting and move the data accordingly but I am be wrong. Any suggestions?

 

[RCBricker]

I am trying to write a VBA code that autofilters , copy and pastes to a new sheet. The names of the sheet will be soft medium hard where those values are found in column B. The problem is the cell that labels it as soft medium or hard has a bunch of filler characters before the designation. For example cell B2 may be 15488621-hard. Therefore I need to search each cell for its designation and copy the whole row to the proper sheet. I tried using the record macro for filter but it only allowed 2 criteria instead of 3. An additional problem that the spreadsheets I am working with contain 20,000+ cells so it needs to be relatively efficient at sorting. The number of rows in a given spreadsheet varies as well so I am not able to set a specific range. At this point I would assume it would be quicker to create the soft, med, hard sheets prior to sorting and move the data accordingly but I am be wrong. Any suggestions?

this will do what you need it to do

Sub CAT()
Dim rng As Range, cell As Range, rngHEAD As Range, rngUSED As Range
Dim lngROW As Long, lngCOL As Long
Dim ws As Worksheet, wsNEW As Worksheet
Dim varI As Variant
Dim strFIL As String, strNAME As String

    Set ws = ActiveSheet
    ws.Columns("B:B").Insert
    lngROW = Cells.Find(What:="*", _
                    after:=Cells(1), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
    lngCOL = Cells.Find(What:="*", _
                    after:=Cells(1), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Column
    
    ws.Cells(1, 2).Value = "FILTER HEADER"
    Set rngHEAD = ws.Range(ws.Cells(1, 1), ws.Cells(1, lngCOL))
    Set rngUSED = ws.Range(ws.Cells(1, 1), ws.Cells(lngROW, lngCOL))
    Set rng = ws.Range(ws.Cells(2, 3), ws.Cells(lngROW, 3))
    For Each cell In rng
        If InStr(1, cell.Value, "hard") > 0 Then
            cell.Offset(, -1).Value = "X"
        ElseIf InStr(1, cell.Value, "soft") > 0 Then
            cell.Offset(, -1).Value = "Y"
        ElseIf InStr(1, cell.Value, "med") > 0 Then
            cell.Offset(, -1).Value = "Z"
        End If
    Next cell
    ws.AutoFilterMode = False
    
    For varI = 1 To 3
        Select Case varI
            Case 1
                strFIL = "X"
                strNAME = "Hard"
            Case 2
                strFIL = "Y"
                strNAME = "Soft"
            Case 3
                strFIL = "Z"
                strNAME = "Med"
        End Select
        rngHEAD.AutoFilter field:=2, Criteria1:=strFIL
        rngUSED.SpecialCells(xlCellTypeVisible).Copy
        Set wsNEW = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        wsNEW.Range("A1").PasteSpecial xlPasteAll
        wsNEW.Name = strNAME
        wsNEW.Columns("B:B").Delete
    Next
    ws.Columns("B:B").Delete
End Sub

As long as no cell being checked contains more than one of the criteria

HTHs