ahuang3433
New Member
- Joined
- Jan 24, 2017
- Messages
- 39
Hi,
I have a code here where I want to edit.
On this portion of the code, instead of filter the list all together I want to filter them 1 by 1. Basically Filter A2 value. This piece needs to be variant since the list could range from A2:A50 at times. But I want it to run 1 at a time.
then run the next portion of the code. This portion doesn't require editing I believe.
The save file piece needs editing. If at all possible it will need to be variant too if I have more than 1 value in column A.
Once I'm done with A2, I want to reopen wb2 and start with A3 value. Obviously only needed.
I have a code here where I want to edit.
On this portion of the code, instead of filter the list all together I want to filter them 1 by 1. Basically Filter A2 value. This piece needs to be variant since the list could range from A2:A50 at times. But I want it to run 1 at a time.
VBA Code:
'Look for Values in List Search
Dim count As Integer
Dim list As Variant
wb1.Activate
count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
list = Split(Join(Application.Transpose(Range(Cells(1, 1), Cells(count, 1)).Value), ","), ",")
'Filter based on List Search Values
WB2.Activate
Sheets("Latest Material Planning").Activate
ActiveSheet.Range("A1").AutoFilter Field:=2, Criteria1:=list, Operator:=xlFilterValues
then run the next portion of the code. This portion doesn't require editing I believe.
VBA Code:
'Data Transfer from Latest Material Planning
Range(Range("B2"), Range("B2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("F2"), Range("F2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("G2"), Range("G2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("M2"), Range("M2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("R2"), Range("R2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("I2"), Range("I2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("F6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("S2"), Range("S2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("G6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("T2"), Range("T2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("H6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("O2"), Range("O2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("J6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("AB2"), Range("AB2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("K6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="NA", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Sheets("Latest Material Planning").Select
Range(Range("AA2"), Range("AA2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("L6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Latest Material Planning").Select
Range(Range("Y2"), Range("Y2").End(xlDown)).Select
Selection.Copy
Sheets("Dashboard").Select
Range("P6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Add formula's to Dashboard Tab
Sheets("Dashboard").Select
Range("N6").Select
lastRow = Range("A" & Rows.count).End(xlUp).Row
Range("N6:N" & lastRow) = "=VLOOKUP(RC[-12],'PM List'!C[-13]:C[-10],4,FALSE)"
Range("I6").Select
lastRow = Range("A" & Rows.count).End(xlUp).Row
Range("I6:I" & lastRow) = "=IF(LEFT(RC[-7],3)=""TBD"",""Red"",IF(RC[-1]>=0,""Green"",IF(AND(RC[2]<>"""",RC[2]>=RC[1]),""Yellow"",""Red"")))"
Range("B1").Select
ActiveCell.FormulaR1C1 = _
"=TEXTJOIN("" | "",TRUE,'List Search'!R[1]C[-1]:R[1048575]C[-1])"
'Format Dashboard Tab
Range("J5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "m/d/yyyy"
Range("A5:Q5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range(Selection, Selection.End(xlDown)).Select
Selection.Columns.AutoFit
Range("I6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""Green"""
Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""Yellow"""
Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""Red"""
Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Sheets("Latest Material Planning").Select
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter
Sheets("List Search").Select
Range("A1").Select
Sheets("Dashboard").Select
Range("A5").Select
Selection.AutoFilter
Columns("A:Q").Select
Selection.Columns.AutoFit
'Custom Sort Column "I" in Dashboard Tab
Range("A5").Select
ActiveWorkbook.Worksheets("Dashboard").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dashboard").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("I2:I10000"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder _
:="Red,Yellow,Green", DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("J2:J10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Dashboard").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$5:$Q$10000").AutoFilter Field:=2, Criteria1:="=TBD*", _
Operator:=xlAnd
Range("G6", Range("G6").End(xlDown)).SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
ActiveSheet.Range("$A$5:$Q$10000").AutoFilter Field:=2
Dim rr As Long
Dim sCell As Range
rr = Cells(Rows.count, 1).End(3).Row
For Each sCell In Range("G6:G" & rr)
If sCell.Value = "" Then
sCell.Formula = sCell.Formula
sCell.Value = "=0"
End If
Next sCell
ActiveSheet.Range("$A$5:$Q$10000").AutoFilter Field:=2, Criteria1:="=TBD*", _
Operator:=xlAnd
Range("N6", Range("N6").End(xlDown)).SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Range("H6", Range("H6").End(xlDown)).SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Dim lr As Long
Dim rCell As Range
lr = Cells(Rows.count, 1).End(3).Row
For Each rCell In Range("H6:H" & lr)
If rCell.Value = "" Then
rCell.Formula = "=RC[-3]*-1"
rCell.Value = rCell.Value
End If
Next rCell
ActiveSheet.Range("$A$5:$Q$10000").AutoFilter Field:=2
Range("A5").Select
The save file piece needs editing. If at all possible it will need to be variant too if I have more than 1 value in column A.
VBA Code:
'Save File based on Cell Value
Dim path As String
Dim filename1 As String
path = "Z:\Other\PjM_Documents\ESR Material Planning\Material Readiness\"
filename1 = path & Range("A2") & " " & Format(Date, "MM-DD-YY")
ActiveWorkbook.SaveAs filename1, FileFormat:=52, CreateBackup:=False
ActiveWorkbook.Close
Once I'm done with A2, I want to reopen wb2 and start with A3 value. Obviously only needed.