Merge offset cells based on cell values

[danielg73]

Hi all. First time poster, long time lurker. I am building a scheduling worksheet that re-formats based on the specified starting date for the calendar. The schedule is structure so each column represents one week. When the starting date is changed, the dates and formatting of the schedule update. To make this more user friendly for my co-workers, while also protecting the bits of the worksheet needed to ensure its functionality, I am employing a mix of formulae and VBA. The formulae occur outside the main body of the worksheet where they can be protected without interrupting the workflow. These formulae calculate year, months, dates, to be displayed, while the VBA references those results to format the body of the schedule.

I intend to sum values for each month and display them in the first column for a given month further down the worksheet, but need to merge cells to make the values visible. To this end I am working on the VBA that will merge specific cells. I have a formula at the head of the worksheet that assigns a month for each column, which the VBA below references as "CodeMo". I want to be able to check for like values and merge cells at a specified offset from the checked values. Below is the VBA I have written thus far, but I keep getting a 'Type mismatch' error for some reason that eludes me. I have gotten this code to merge the cells in my check range, but not the offset range, which leads me to believe that the error is somewhere in there.

Some caveats: I am (poorly) self taught with VBA (usually lots of on-line research followed by trial and error); the following is a subset of my worksheet (I like to keep things isolated until they work); once its working, this code will be used to merge cells in several ranges based on a single result, thus the "rMrg1".

Appreciate any help with this problem or just pointers on how to improve my skills (and posts). Thanks in advance

Sub MergeBasedOnMonth()

'DISABLE EXCEL SETTINGS
'Check current state of various Excel settings and temporarily turn off to allow macro to run faster
'    ActiveSheet.Unprotect Password:=""

    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    calcState = Application.Calculation
    eventsState = Application.EnableEvents
    displayPageBreakState = ActiveSheet.DisplayPageBreaks 'sheet-level setting

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayAlerts = False

'Merge cells based on change of month (this allows data entry to be visible)
Dim CodeMo As Range: Set CodeMo = Range("E4:FD4")
Dim cMrg As Range

    For Each cMrg In CodeMo
        Dim rMrg1 As Range: Set rMrg1 = Range(cMrg.Offset(8, 0), cMrg.Offset(8, 1))
        If cMrg.Value = cMrg.Offset(0, 1).Value Then
            rMrg1.Merge
        Else
            rMrg1.UnMerge
        End If
    Next cMrg

'REINSTATE EXCEL settings
'Restore functions after macro has completed
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.EnableEvents = True
Application.DisplayAlerts = True

'ActiveSheet.Protect Password:=""

End Sub

 

[danielg73]

FWIW I figured out a solution that addressed what I believe was an issue with the functional limits of the approach I originally adopted and figured I should share should someone have the same question in the future. I am admittedly out of my depth, so I would be curious if the issue was obvious, thus the lack of response, or if I could have better stated the issue or result I attempting to achieve? Anyway, instead of attempting to merge two offset ranges, I used the union function to consolidate the ranges of interest and then merged them. Perhaps an obvious issue with my previous attempt? Thoughts/feedback appreciated.

Sub MergeBasedOnMonth()

Dim CodeMo As Range: Set CodeMo = Range("A1:AN1")
Dim cChk As Range

    For Each cChk In CodeMo
        If cChk.Value = cChk.Offset(0, 1).Value Then
            Dim cMrg As Range: Set cMrg = Union(cChk, cChk.Offset(0, 1))
        cMrg.Offset(8, 0).Merge
        End If
    Next cChk

End Sub