Code clearing the fill color of cells?

[andrewb90]

Hello All,

I have a macro that clears data from a sheet and gets it ready to start a new week, but a few merged cells keep getting their fill color cleared. Now, I can always just have my code fill the gradient colors back in, but I'd rather try to fix what is causing the issue instead.

My sheet is the sheet: "Scheduler"
My problem ranges are:
D88:V88, D107:V107, D126:V126, D145:V145, D164:V164
All of these are merged cells.
Also, D193:V193 is in the same boat as being skipped by my code, but that range doesn't have any problems.
Here's my code:

Private Sub Reset()Application.ScreenUpdating = False
Application.Run "module5.destructure"
Dim msg, Style, Title
msg = "Are you ready to start a new week?" & vbNewLine & "The existing schedule will be erased."
Style = vbYesNo + vbExclamation
Title = "Final Answer?"
Response = MsgBox(msg, Style, Title, Help, Ctxt)
If Response = vbNo Then
    MyString = "No"
    Exit Sub
Else
    MyString = "Yes"
    Sheets("Print").Visible = True
    Sheets("Print").Select
    
Sheets("Sales").Visible = True
Sheets("Sales").Select
ActiveSheet.Unprotect "password"


Sheets("Scheduler").Select
ActiveSheet.Unprotect "password"


Range("E89:R106").ClearContents ' front of house
Range("E89:R106").Select
Application.Run "module1.Clear_reset"
Range("B89:B106").ClearContents


Range("E108:R125").ClearContents
Range("E108:R125").Select
Application.Run "module1.Clear_reset"
Range("B108:B125").ClearContents




Range("E127:R144").ClearContents ' back of house
Range("E127:R144").Select
Application.Run "module1.Clear_reset"
Range("B127:B144").ClearContents


Range("E146:R163").ClearContents
Range("E146:R163").Select
Application.Run "module1.Clear_reset"
Range("B146:B163").ClearContents




Range("E165:R192").ClearContents ' prep
Range("E65:R192").Select
Application.Run "module1.Clear_reset"
Range("B165:B192").ClearContents




Range("E194:R207").ClearContents ' mgr
Range("E194:R207").Select
Application.Run "module1.Clear_reset"
Range("B194:B207").ClearContents


Application.Run "module19.resetextraprojections" ' projections


Sheets("Scheduler").Select
Range("N2").Select ' resetting individual email function
ActiveCell.FormulaR1C1 = "0"


    Range("E84:F84").Select
    Selection.Copy
    Range("Y1").Select
    ActiveSheet.Paste
    Range("E84").Select
    ActiveCell.FormulaR1C1 = Range("y1") + 7


Application.Run "module1.Reset_MasterAvail"  'module 1


'CALL CLEAR THE ROSTERS
Call ClearRoster


End If






Sheets("Print").Select
Rows("5:124").Hidden = False
Sheets("Print").Range("G6:AA23,G25:AA42,G44:AA61,G63:AA80,G82:AA109,G111:AA124").Font.ColorIndex = xlAutomatic
Sheets("Scheduler").Select




Range("166:166,168:168,170:170,172:172,174:174,176:176,178:178,180:180,182:182,184:184,186:186,188:188,190:190,192:192").EntireRow.Hidden = True
Range("A1").Select
Application.Run "module1.HideAllExceptScheduler"
Sheets("Sales").Visible = True
Sheets("Sales").Select
Range("D9:J14").Select
With Selection.Font
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
End With
Sheets("Scheduler").Select
ActiveSheet.Protect "password", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True
Sheets("Sales").Select
Sheets("Scheduler").Visible = xlSheetVeryHidden
ActiveSheet.Protect "password", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True
Application.Run "module5.structure"
ActiveWorkbook.Save
MsgBox "The sheet has been reset." & vbNewLine & "Please enter the last completed weeks sales and adjust the projections."
Application.ScreenUpdating = True
End Sub

Here is Clear_reset (module 1):

Private Sub Clear_reset()
 Dim rngMyRow As Range
Sheets("Print").Visible = True
With Selection
    .Interior.Color = xlNone
    .Font.ColorIndex = xlAutomatic
End With


Sheets("RO").Visible = True
Sheets("RO").Range("C4:P122").ClearContents
Sheets("RO").Visible = xlSheetVeryHidden
Sheets("Scheduler").Select
Columns("C:C").Hidden = False
Columns("B:B").Hidden = True
End Sub

The other called subs don't affect the sheet scheduler. Any advice would be greatly appreciated!

 

[Michael M]

Probably the simplest way would be to UNmerge the cells....Merging cells should have been removed from EXcel years ago !!
Try highlighting the cells that are merged, Unmerge them, then change to
>>Rightclick>>Format>>Alignment>>Horizontal>>"Center across selection"

Otherwise recolouring after each clear is probably the next best option !!

 

[andrewb90]

I tried that, but my gradient fills appears in each cell still .
But regardless of merged or not, my code shouldn't be clearing the fill color right? Or am I overlooking something in my code?

 

[Michael M]

Couldn't you use clear instead of going back and forth to the reset macro ??.....or am I missing something here !

With Sheets("Scheduler")
    .Unprotect "password"
    .Range("E89:R106,E108:R125,E127:R144,E146:R163,E165:R192,E194:R207").Clear ' front of house
    .Range("B89:B106,B108:B125,B127:B144,B146:B163,B165:B192,B194:B207").Clear
End With

Instead of

Sheets("Scheduler").Select
ActiveSheet.Unprotect "password"


Range("E89:R106").ClearContents ' front of house
Range("E89:R106").Select
Application.Run "module1.Clear_reset"
Range("B89:B106").ClearContents


Range("E108:R125").ClearContents
Range("E108:R125").Select
Application.Run "module1.Clear_reset"
Range("B108:B125").ClearContents




Range("E127:R144").ClearContents ' back of house
Range("E127:R144").Select
Application.Run "module1.Clear_reset"
Range("B127:B144").ClearContents


Range("E146:R163").ClearContents
Range("E146:R163").Select
Application.Run "module1.Clear_reset"
Range("B146:B163").ClearContents




Range("E165:R192").ClearContents ' prep
Range("E65:R192").Select
Application.Run "module1.Clear_reset"
Range("B165:B192").ClearContents




Range("E194:R207").ClearContents ' mgr
Range("E194:R207").Select
Application.Run "module1.Clear_reset"
Range("B194:B207").ClearContents