W
Walter
Here is the code I have but am having problems with my loop for filling the
cells in the new range:
Sub AutoFillColE()
'
' AutoFillColE Macro
' Auto fill col E based upon length of Current Region
'
Dim rngCell As Range
Dim rngCurrent As Range
Dim shtFlagelNoB05 As Worksheet
Set shtFlagelNoB05 = Application.ActiveWorkbook.Worksheets("Flagel_ERP_NoB05")
Set rngCurrent = shtFlagelNoB05.Range("A4").CurrentRegion
Set rngCurrent = rngCurrent.Offset(rowoffset:=1, columnoffset:=4)
Set rngCurrent = rngCurrent.Resize(RowSize:=rngCurrent, ColumnSize:=1)
'Paste formula in each cell in Column E from E5 down to bottom of new
range
For Each rngCell In rngCurrent
rngcell.Formula = "=IF(B4 <= TODAY()-77,"11+ Weeks",IF(B4 <=
TODAY()-42,"6 to 10 Weeks",IF(B4 <= TODAY()-7,"1 to 5 Weeks",IF(B4 >
TODAY()-7,"Current Week"))))"
Next rngCell
End Sub
cells in the new range:
Sub AutoFillColE()
'
' AutoFillColE Macro
' Auto fill col E based upon length of Current Region
'
Dim rngCell As Range
Dim rngCurrent As Range
Dim shtFlagelNoB05 As Worksheet
Set shtFlagelNoB05 = Application.ActiveWorkbook.Worksheets("Flagel_ERP_NoB05")
Set rngCurrent = shtFlagelNoB05.Range("A4").CurrentRegion
Set rngCurrent = rngCurrent.Offset(rowoffset:=1, columnoffset:=4)
Set rngCurrent = rngCurrent.Resize(RowSize:=rngCurrent, ColumnSize:=1)
'Paste formula in each cell in Column E from E5 down to bottom of new
range
For Each rngCell In rngCurrent
rngcell.Formula = "=IF(B4 <= TODAY()-77,"11+ Weeks",IF(B4 <=
TODAY()-42,"6 to 10 Weeks",IF(B4 <= TODAY()-7,"1 to 5 Weeks",IF(B4 >
TODAY()-7,"Current Week"))))"
Next rngCell
End Sub