[SOLVED:] Filter Data Using Macro

Filter Data Using Macro

I am trying to use a macro to filter data that I have. I want all items starting the characters TEMP and CR- to be filtered. I have working code below, but it has a few issues. I have items starting with the characters SCR-, ZZZ_CR- and ZZZ_Temp, and they get filtered into my list as well. I don't want them to. I only want items with the initial 4 characters being TEMP and initial 3 characters being CR-.
Also, in my code, I have the variable j. I want j to equal the amount of rows I have in the named array "ITEM_NUMBER". I'm not sure how to do that.
If I could get the corresponding lists to be named TEMP_FILTER & CR_FILTER, that would be GREAT as well!
Thank you in advance!

Code:

Sub Filter() 'On Error Resume Next Dim i t = 1 c = 1 'j = WorksheetFunction.Rows([ITEM_NUMBER]).Value j = 1000000 For i = 1 To j 'TEMP If InStr(1, Worksheets("Oracle Item Numbers").Cells(1 + i, 1).Value, "TEMP", 1) Then Worksheets("Templates & Common Routings").Cells(1 + t, 10).Value = Worksheets("Oracle Item Numbers").Cells(1 + i, 1).Value t = t + 1 End If 'CR- If InStr(1, Worksheets("Oracle Item Numbers").Cells(1 + i, 1).Value, "CR-", 1) Then Worksheets("Templates & Common Routings").Cells(1 + c, 11).Value = Worksheets("Oracle Item Numbers").Cells(1 + i, 1).Value c = c + 1 End If Next i End Sub

Latest Code: Still have the same issues, but I fixed some other minor things.

Code:

Sub Filter() 'On Error Resume Next Worksheets("Templates & Common Routings").Columns("J:K").ClearContents Worksheets("Templates & Common Routings").Columns("J:K").Borders.LineStyle = xlNone Dim i t = 1 c = 1 'j = WorksheetFunction.Rows([ITEM_NUMBER]).Value j = 10000000 For i = 1 To j 'TEMP If InStr(1, Worksheets("Oracle Item Numbers").Cells(1 + i, 1).Value, "TEMP", 1) Then Worksheets("Templates & Common Routings").Cells(1 + t, 10).Value = Worksheets("Oracle Item Numbers").Cells(1 + i, 1).Value Worksheets("Templates & Common Routings").Cells(1 + t, 10).Borders.LineStyle = xlContinuous t = t + 1 End If 'CR- If InStr(1, Worksheets("Oracle Item Numbers").Cells(1 + i, 1).Value, "CR-", 1) Then Worksheets("Templates & Common Routings").Cells(1 + c, 11).Value = Worksheets("Oracle Item Numbers").Cells(1 + i, 1).Value Worksheets("Templates & Common Routings").Cells(1 + c, 11).Borders.LineStyle = xlContinuous c = c + 1 End If Next i Worksheets("Templates & Common Routings").Range("j1") = "Templates" Worksheets("Templates & Common Routings").Range("k1") = "Common Routings" End Sub

?

Code:

Sub vbax_54965_Copy_Matching_Cells() With Worksheets("Oracle Item Numbers") .AutoFilterMode = False .Cells(1).AutoFilter Field:=1, Criteria1:="TEMP*" .UsedRange.Columns(1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Worksheets("Templates & Common Routings").Cells(2, 10).PasteSpecial .Cells(1).AutoFilter Field:=1, Criteria1:="CR-*" .UsedRange.Columns(1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Worksheets("Templates & Common Routings").Cells(2, 11).PasteSpecial .AutoFilterMode = False End With End Sub

Thank you! Much more efficient than my code. And it works!
But how can I get borders around each cell?
Also, I would like to name each list (TEMP_FILTER & CR_FILTER) so I can refer to them in formulas.

Quote:

Originally Posted by mancubus

?

Code:

Sub vbax_54965_Copy_Matching_Cells() With Worksheets("Oracle Item Numbers") .AutoFilterMode = False .Cells(1).AutoFilter Field:=1, Criteria1:="TEMP*" .UsedRange.Columns(1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Worksheets("Templates & Common Routings").Cells(2, 10).PasteSpecial .Cells(1).AutoFilter Field:=1, Criteria1:="CR-*" .UsedRange.Columns(1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Worksheets("Templates & Common Routings").Cells(2, 11).PasteSpecial .AutoFilterMode = False End With End Sub

I figured it out! Thank you!

Quote:

Originally Posted by Nick72310

Thank you! Much more efficient than my code. And it works!
But how can I get borders around each cell?
Also, I would like to name each list (TEMP_FILTER & CR_FILTER) so I can refer to them in formulas.

You are welcome.