Code was working fine then Runtime error

[asdsparky]

I have a workbook in which I will import the current month's worksheet and run a code to compare with the previous month and return the differences onto a third worksheet. I was using the following code with no issues, then suddenly out of nowhere I get a "Runtime error '1004: Application-defined or object defined error". I have been tweaking the code to bring categories over from the "New Data" sheet (just to identify the categories on the results ("Changes") sheet), but I never changed anything that I can tell, that would rngC info. Debug highlights what I have in RED below. Any thoughts?

I also need to figure out how to get my italicized text that results from the code under 'Categories, to populate its own line. right now, it populates on the same rows with the changes.

Sub CompareSheets()
[COLOR=#009933]' constants
' worksheets & ranges
' original[/COLOR]
Const ksWSOriginal = "OldData"
Const ksOriginal = "OriginalTable"
Const ksOriginalKey = "OriginalKey"
[COLOR=#009933]' updated[/COLOR]
Const ksWSUpdated = "NewData"
Const ksUpdated = "UpdatedTable"
Const ksUpdatedKey = "UpdatedKey"
[COLOR=#009933]' changes[/COLOR]
Const ksWSChanges = "CHANGES"
Const ksChanges = "ChangesTable"
[COLOR=#009933]' labels[/COLOR]
Const ksChange = "CHANGE"
Const ksRemove = "REMOVE"
Const ksAdd = "ADD"
[COLOR=#009933]'
' declarations[/COLOR]
Dim rngO As Range, rngOK As Range, rngU As Range, rngUK As Range, rngC As Range
Dim c As Range
Dim I As Long, J As Long, lChanges As Long, lRow As Long, bEqual As Boolean
Call OptimizeCode_Begin
[COLOR=#009933]' start[/COLOR]
Set rngO = Worksheets(ksWSOriginal).Range(ksOriginal)
Set rngOK = Worksheets(ksWSOriginal).Range(ksOriginalKey)
Set rngU = Worksheets(ksWSUpdated).Range(ksUpdated)
Set rngUK = Worksheets(ksWSUpdated).Range(ksUpdatedKey)
[COLOR=#ff0000]Set rngC = Worksheets(ksWSChanges).Range(ksChanges)[/COLOR]
With rngC
    If .Rows.Count > 1 Then
        Range(.Rows(2), .Rows(.Rows.Count)).ClearContents
        Range(.Rows(2), .Rows(.Rows.Count)).Font.ColorIndex = xlColorIndexAutomatic
        Range(.Rows(2), .Rows(.Rows.Count)).Font.Bold = False
    End If
End With
[COLOR=#009933]' process[/COLOR]
lChanges = 1
[COLOR=#009933]'Categories[/COLOR]
With rngU
    For I = 1 To .Rows.Count
        If rngUK.Cells(I, 2).Font.Bold Then
        For J = 1 To rngU.Columns.Count
                rngC.Cells(I, J).Value = rngU.Cells(I, J).Value
                rngC.Cells(I, J).Interior.Color = RGB(180, 180, 180)
                rngC.Cells(I, J).Font.Color = vbBlack
                rngC.Cells(I, J).Font.Bold = True
            Next J
       End If
    Next I
End With
[COLOR=#009933]' 1st pass: updates & deletions[/COLOR]
With rngOK
    For I = 1 To .Rows.Count
        Set c = rngUK.Find(.Cells(I, 1).Value, , xlValues, xlWhole)
        If c Is Nothing Then
            [COLOR=#009933]' deletion[/COLOR]
           lChanges = lChanges + 1
            rngC.Cells(lChanges, 1).Value = ksRemove
            For J = 1 To rngO.Columns.Count
                rngC.Cells(lChanges, J + 1).Value = rngO.Cells(I, J).Value
                rngC.Cells(lChanges, J + 1).Interior.Color = RGB(255, 0, 0)
                rngC.Cells(lChanges, J + 1).Font.Color = vbWhite
                rngC.Cells(lChanges, J + 1).Font.Bold = True
            Next J
        Else
            bEqual = True
            lRow = c.Row - rngUK.Row + 1
            For J = 1 To rngO.Columns.Count
                If rngO.Cells(I, J).Value <> rngU.Cells(lRow, J).Value Then
                    bEqual = False
                    Exit For
                End If
            Next J
            If Not bEqual Then
                [COLOR=#009933]' change[/COLOR]
               lChanges = lChanges + 1
                rngC.Cells(lChanges, 1).Value = ksChange
                For J = 1 To rngO.Columns.Count
                    If rngO.Cells(I, J).Value = rngU.Cells(lRow, J).Value Then
                        rngC.Cells(lChanges, J + 1).Value = rngO.Cells(I, J).Value
                    Else
                        rngC.Cells(lChanges, J + 1).Value = rngU.Cells(lRow, J).Value
                        rngC.Cells(lChanges, J + 1).Interior.Color = RGB(153, 51, 0)
                        rngC.Cells(lChanges, J + 1).Font.Color = vbWhite
                        rngC.Cells(lChanges, J + 1).Font.Bold = True
                    End If
                Next J
            End If
        End If
    Next I
End With
[COLOR=#009933]' 2nd pass: additions[/COLOR]
With rngUK
    For I = 1 To .Rows.Count
        Set c = rngOK.Find(.Cells(I, 1).Value, , xlValues, xlWhole)
        If c Is Nothing Then
            [COLOR=#009933]' addition[/COLOR]
           lChanges = lChanges + 1
            rngC.Cells(lChanges, 1).Value = ksAdd
            For J = 1 To rngU.Columns.Count
                rngC.Cells(lChanges, J + 1).Value = rngU.Cells(I, J).Value
                rngC.Cells(lChanges, J + 1).Interior.Color = RGB(0, 128, 0)
                rngC.Cells(lChanges, J + 1).Font.Color = vbWhite
                rngC.Cells(lChanges, J + 1).Font.Bold = True
            Next J
        End If
    Next I
End With
[COLOR=#009933]'
' end[/COLOR]
Call OptimizeCode_End
Worksheets(ksWSChanges).Activate
rngC.Cells(2, 3).Select
Set rngC = Nothing
Set rngUK = Nothing
Set rngU = Nothing
Set rngOK = Nothing
Set rngO = Nothing
Beep
[COLOR=#009933]'[/COLOR]
End Sub
Sub OptimizeCode_Begin()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
EventState = Application.EnableEvents
Application.EnableEvents = False
PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False
End Sub
Sub OptimizeCode_End()
ActiveSheet.DisplayPageBreaks = PageBreakState
Application.EnableEvents = EventState
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub ClearDataCompare()
    Sheets("CHANGES").Select
    Rows("2:1000").Select
    Selection.ClearContents
    Selection.ClearFormats
    Range("B1").Select
    
End Sub

 

[JoeMo]

Is ksChanges a defined range at the workbook level in your workbook? If yes, try removing the worksheet qualifier from that line. If the defined range has global scope, VBA doesn't need (or want) a worksheet qualifier.
Try:

Set rngC = Range(ksChanges)

 

[asdsparky]

Removing the worksheet qualifier resulted in a new runtime error: "Method 'Range' of object '_Global failed." This was working fine for several days until this morning when I was working on it, I hit the "clear contents" button after running a comparison, then the next time I ran the "compare" function, I got the runtime error. I can still open a copy of this from my email, with the same VBA (minus some changes to the colors) and it runs fine. I've made no changes to the Set rngC function. I'm at a loss.

 

[asdsparky]

Problem solved. Applied a different code that seems to be much more stable (and frankly, easier to tweak).

Option Explicit
Dim miMaxColumns As Integer
Sub CompareSheets()
Dim bChanged As Boolean, baChanged() As Boolean
Dim iColEnd As Integer, iCol As Integer, iCol1 As Integer, iCol2 As Integer
Dim lRow1 As Long, lRow2 As Long, lReportRow As Long
Dim objDictOld As Object, objDictNew As Object
Dim vKeys As Variant, vKey As Variant
Dim vaInput() As Variant, vaOutput() As Variant, vaOutput2() As Variant
Dim vaInputOld As Variant, vaInputNew As Variant
Dim wsOld As Worksheet, wsNew As Worksheet, wsReport As Worksheet

Set wsOld = Sheets("PreviousMonth")
miMaxColumns = wsOld.Cells(1, Columns.Count).End(xlToLeft).Column
Set objDictOld = PopulateDictionary(WS:=wsOld)
Set wsNew = Sheets("CurrentMonth")
Set objDictNew = PopulateDictionary(WS:=wsNew)
Set wsReport = Sheets("Adjustments")
With wsReport
    .Cells.ClearFormats
    .Cells.ClearContents
End With
wsOld.Range("A1:" & wsOld.Cells(1, miMaxColumns).Address).Copy
wsReport.Range("B1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
lReportRow = 1
vKeys = objDictOld.Keys
For Each vKey In vKeys
    ReDim vaInputOld(1 To 1, 1 To miMaxColumns)
    vaInputOld = objDictOld.Item(vKey)
    If objDictNew.exists(vKey) Then
        ReDim vaInputNew(1 To 1, 1 To miMaxColumns)
        vaInputNew = objDictNew.Item(vKey)
        ReDim vaOutput(1 To 1, 1 To miMaxColumns + 1)
        ReDim vaOutput2(1 To 1, 1 To miMaxColumns + 1)
        ReDim baChanged(1 To miMaxColumns)
        bChanged = False
        For iCol = 1 To miMaxColumns
            vaOutput(1, iCol + 1) = vaInputOld(1, iCol)
            If vaInputOld(1, iCol) <> vaInputNew(1, iCol) Then
                vaOutput2(1, iCol + 1) = vaInputNew(1, iCol)
                baChanged(iCol) = True
                bChanged = True
            End If
        Next iCol
        If bChanged Then
            lReportRow = lReportRow + 1
            For iCol = 1 To UBound(baChanged)
                If baChanged(iCol) Then
                    With wsReport
                        .Range(.Cells(lReportRow, iCol + 1).Address, _
                               .Cells(lReportRow + 1, iCol + 1).Address).Interior.Color = RGB(255, 255, 153) 'light yellow
                    End With
                End If
            Next iCol
            
            vaOutput(1, 1) = "Adjusted"
            With wsReport
                .Range(.Cells(lReportRow, 1).Address, _
                       .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput
                lReportRow = lReportRow + 1
                .Range(.Cells(lReportRow, 1).Address, _
                       .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput2
                       .Range(.Cells(lReportRow, 1).Address, _
                       .Cells(lReportRow, miMaxColumns + 1).Address).Borders(xlEdgeBottom).LineStyle = xlContinuous
            End With
        End If
        objDictOld.Remove vKey
        objDictNew.Remove vKey
    Else
        ReDim vaOutput(1 To 1, 1 To miMaxColumns + 1)
        vaOutput(1, 1) = "Deleted"
        For iCol = 1 To miMaxColumns
            vaOutput(1, iCol + 1) = vaInputOld(1, iCol)
        Next iCol
        
        lReportRow = lReportRow + 1
        With wsReport
            .Range(.Cells(lReportRow, 1).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Interior.Color = RGB(255, 137, 137) 'light red
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Borders(xlEdgeTop).LineStyle = xlContinuous
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Borders(xlEdgeRight).LineStyle = xlContinuous
        End With
    End If
Next vKey
If objDictNew.Count <> 0 Then
    vKeys = objDictNew.Keys
    For Each vKey In vKeys
        ReDim vaOutput2(1 To 1, 1 To miMaxColumns + 1)
        vaInputNew = objDictNew.Item(vKey)
        vaOutput2(1, 1) = "Added"
        For iCol = 1 To miMaxColumns
            vaOutput2(1, iCol + 1) = vaInputNew(1, iCol)
        Next iCol
        lReportRow = lReportRow + 1
        With wsReport
            .Range(.Cells(lReportRow, 1).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput2
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Interior.Color = RGB(180, 222, 154) 'light green
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Borders(xlEdgeTop).LineStyle = xlContinuous
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Borders(xlEdgeRight).LineStyle = xlContinuous
        End With
    Next vKey
End If
objDictOld.RemoveAll
Set objDictOld = Nothing
objDictNew.RemoveAll
Set objDictNew = Nothing
End Sub
Private Function PopulateDictionary(ByRef WS As Worksheet) As Object
Dim lRowEnd As Long, lRow As Long
Dim rCur As Range
Dim sKey As String
Set PopulateDictionary = Nothing
Set PopulateDictionary = CreateObject("Scripting.Dictionary")
lRowEnd = WS.Cells(Rows.Count, "A").End(xlUp).Row
For lRow = 2 To lRowEnd
    sKey = Trim$(LCase$(CStr(WS.Range("A" & lRow).Value)))
    On Error Resume Next
    PopulateDictionary.Add Key:=sKey, Item:=WS.Range(WS.Cells(lRow, 1).Address, _
                                            WS.Cells(lRow, miMaxColumns).Address).Value
    On Error GoTo 0
Next lRow
End Function

Sub ClearDataCompare()
    Sheets("Adjustments").Select
    Rows("2:1000").Select
    Selection.ClearContents
    Selection.ClearFormats
    Range("B1").Select
    
End Sub