MrClueless
New Member
- Joined
- May 29, 2013
- Messages
- 8
I am trying to filter out data based on specific data that changes based on location, I am trying to see if their is a way to adjust the filter code to use the data on a list I created as the filter criteria, once it has gone through the whole list it would continue with the rest of the macro: The following code is what I have so far, however I know that under the Filter Criteria "SCBR00" it is specific and will not work. I am new to VBA so any help or suggestions possibly a completely different way of accomplishing what I need would be great
' Select cell A2, *first line of data*.
Sheets("Salinas").Select
Range("A2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
' Insert your code here.
' Step down 1 row from present location.
'**********************************************************************
Sheets("Master").Select
Cells.Select
Selection.AutoFilter
'ActiveSheet.Range("$A$1:$N$5000").AutoFilter Field:=7, Criteria1:="SCBR00"
ActiveSheet.Range("$A$1:$N$5000").AutoFilter Field:=7, Criteria1:="Crew"
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Range("O1").Select
ActiveCell.FormulaR1C1 = "regular and overtime earnings"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=MODE(R2C9:R5000C9)"
Range("O2:O2").AutoFill Destination:=Range("O2:O" & Cells(Rows.Count, "A").End(xlUp).Row)
Columns("O:O").Select
Selection.Copy
Columns("I:I").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("O:O").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = Range("G2")
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Cells.Select
Sheets("Master").Select
'***********************************************************************************
ActiveCell.Offset(1, 0).Select
Loop
End Sub
' Select cell A2, *first line of data*.
Sheets("Salinas").Select
Range("A2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
' Insert your code here.
' Step down 1 row from present location.
'**********************************************************************
Sheets("Master").Select
Cells.Select
Selection.AutoFilter
'ActiveSheet.Range("$A$1:$N$5000").AutoFilter Field:=7, Criteria1:="SCBR00"
ActiveSheet.Range("$A$1:$N$5000").AutoFilter Field:=7, Criteria1:="Crew"
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Range("O1").Select
ActiveCell.FormulaR1C1 = "regular and overtime earnings"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=MODE(R2C9:R5000C9)"
Range("O2:O2").AutoFill Destination:=Range("O2:O" & Cells(Rows.Count, "A").End(xlUp).Row)
Columns("O:O").Select
Selection.Copy
Columns("I:I").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("O:O").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = Range("G2")
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Cells.Select
Sheets("Master").Select
'***********************************************************************************
ActiveCell.Offset(1, 0).Select
Loop
End Sub