Originally Posted by
EdwardOcampo
I think we are good.
It worked.
Thank you all.
Will submit my final code for feedback.
Good morning All,
Feedback will be appreciated.
It took a little less than a minute to run.
Thank you.
Sub LSRSetUp()
ActiveSheet.Name = "Low Stock Report"
Cells.Replace what:="2nd Item Number", Replacement:="Item#"
Cells.Replace what:="ABC 1 Sls", Replacement:="ABC"
Cells.Replace what:="Out of Stock", Replacement:="Available"
Range("AH2").Value = "Comment T1"
Range("AN2").Value = "Comment T2"
Range("AT2").Value = "Comment T3"
Range("AZ2").Value = "Comment T4"
Range("BF2").Value = "Comment T5"
Range("BL2").Value = "Comment T6"
Range("BS2").Value = "Comment T7"
Cells.Replace what:="Remaining Forecast", Replacement:="Remaining " & MonthName(Month(Now())) & " Forecast"
Cells.Replace what:="Cur Shortage", Replacement:=MonthName(Month(Now())) & " Shortage"
Cells.Replace what:="Cur+1 Forecast", Replacement:=MonthName(1 + Month(Now())) & " Forecast"
Cells.Replace what:="Cur+1 Shortage", Replacement:=MonthName(1 + Month(Now())) & " Shortage"
Cells.Replace what:="Cur+2 Forecast", Replacement:=MonthName(2 + Month(Now())) & " Forecast"
Cells.Replace what:="Cur+2 Shortage", Replacement:=MonthName(2 + Month(Now())) & " Shortage"
Cells.Replace what:="Cur+3 Forecast", Replacement:=MonthName(3 + Month(Now())) & " Forecast"
Cells.Replace what:="Cur+3 Shortage", Replacement:=MonthName(3 + Month(Now())) & " Shortage"
Cells.Replace what:="Cur+4 Forecast", Replacement:=MonthName(4 + Month(Now())) & " Forecast"
Cells.Replace what:="Cur+4 Shortage", Replacement:=MonthName(4 + Month(Now())) & " Shortage"
Set Rg1 = Range("N1:N1,R1:R1,U1:U1,W1:W1,Z1:Z1,AB1:AB1")
Rg1.Interior.ColorIndex = 3
Rg1.Font.Bold = True
Set Rg2 = Range("Q1:Q1,T1:T1,V1:V1,Y1:Y1,AA1:AA1")
Rg2.Interior.ColorIndex = 6
Range("AC1:AH1,AU1:AZ1").Interior.ColorIndex = 15
Range("AI1:AN1").Interior.ColorIndex = 40
Range("AO1:AT1").Interior.ColorIndex = 5
Range("BA1:BF1,BM1:BS1").Interior.ColorIndex = 48
Range("BG1:BL1").Interior.ColorIndex = 10
With ActiveWindow
.SplitColumn = 2
.SplitRow = 1
.FreezePanes = True
End With
Dim Range1 As Range
Set Range1 = Range("N2:N5000")
For Each cell In Range1
If cell.Value < 1 Then
cell.Interior.ColorIndex = 3
End If
Next
Set Range1 = Range("r2:r5000")
For Each cell In Range1
If cell.Value < 1 Then
cell.Interior.ColorIndex = 3
End If
Next
Set Range1 = Range("u2:u5000")
For Each cell In Range1
If cell.Value < 1 Then
cell.Interior.ColorIndex = 3
End If
Next
Set Range1 = Range("w2:w5000")
For Each cell In Range1
If cell.Value < 1 Then
cell.Interior.ColorIndex = 3
End If
Next
Set Range1 = Range("z2:z5000")
For Each cell In Range1
If cell.Value < 1 Then
cell.Interior.ColorIndex = 3
End If
Next
Set Range1 = Range("AB2:AB5000")
For Each cell In Range1
If cell.Value < 1 Then
cell.Interior.ColorIndex = 3
End If
Next
Dim Range2 As Range
Set Range2 = Range("N2:AB5000")
For Each cell In Range2
If cell.Interior.ColorIndex = 3 Then
cell.Font.Bold = True
End If
Next
With ActiveSheet
.AutoFilterMode = False
.Range("A1:BW1").AutoFilter
End With
Range("B:B").Replace "'", ""
End Sub