sub won't fill down via code

[SLP]

Hi, I have a sub that inserts the fill color of A1 into B2. The code is
supposed to copy the formula down but it doesn't although the fill down code
works all other times. I can manually pull the fill down but don't want my
end users to have to do that. Here is the code. Anyone see anything I
don't? Thanks.

Function GetFillColor(rng As Range) As Long
GetFillColor = rng.Interior.ColorIndex
End Function
Sub GetFillNEW()


Application.ScreenUpdating = False
Application.StatusBar = "Now processing"
Application.DisplayAlerts = False


Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Range("B1").Select
ActiveCell.FormulaR1C1 = "=GetFillColor(RC[-1])"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B1705"), Type:=xlFillDefault


Application.ScreenUpdating = True
Application.StatusBar = "Ready"
Application.DisplayAlerts = True

End Sub

 

[Michael]

Add this at the end of your code:
Cells.Replace What:="=", Replacement:="=", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False

 

[Michael]

My bad, I checked the code and it tries to recalculate the formula each time
therefore just replace your code for this. I did test it and it
works.Function GetFillColor(rng As Range) As Long
GetFillColor = rng.Interior.ColorIndex
End Function
Sub GetFillNEW()


Application.ScreenUpdating = False
Application.StatusBar = "Now processing"
Application.DisplayAlerts = False


Columns("B:B").Select
Selection.Insert Shift:=xlToRight

Range("B1:B1705").FormulaR1C1 = "=GetFillColor(RC[-1])"
Application.ScreenUpdating = True
Application.StatusBar = "Ready"
Application.DisplayAlerts = True
End Sub

 

[SLP]

Thank you very much. I'll have happy end users now. Enjoy the weekend.

My bad, I checked the code and it tries to recalculate the formula each time
therefore just replace your code for this. I did test it and it
works.Function GetFillColor(rng As Range) As Long
GetFillColor = rng.Interior.ColorIndex
End Function
Sub GetFillNEW()


Application.ScreenUpdating = False
Application.StatusBar = "Now processing"
Application.DisplayAlerts = False


Columns("B:B").Select
Selection.Insert Shift:=xlToRight

Range("B1:B1705").FormulaR1C1 = "=GetFillColor(RC[-1])"
Application.ScreenUpdating = True
Application.StatusBar = "Ready"
Application.DisplayAlerts = True
End Sub


--
If this posting was helpful, please click on the Yes button.
Regards,

Michael Arch.

Hi, I have a sub that inserts the fill color of A1 into B2. The code is
supposed to copy the formula down but it doesn't although the fill down code
works all other times. I can manually pull the fill down but don't want my
end users to have to do that. Here is the code. Anyone see anything I
don't? Thanks.

Function GetFillColor(rng As Range) As Long
GetFillColor = rng.Interior.ColorIndex
End Function
Sub GetFillNEW()


Application.ScreenUpdating = False
Application.StatusBar = "Now processing"
Application.DisplayAlerts = False


Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Range("B1").Select
ActiveCell.FormulaR1C1 = "=GetFillColor(RC[-1])"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B1705"), Type:=xlFillDefault


Application.ScreenUpdating = True
Application.StatusBar = "Ready"
Application.DisplayAlerts = True

End Sub