Help on some VBA code I inherited

[philwojo]

OK, so I hate to post like this, but I'm being asked to help out on this and I really don't know what is wrong, and I"m not super strong with VBA code.

I have copied the complete code below, and the line that is being flagged is highlighted in Red and made large in the code. I am getting a "Run-time errro '1004': - Unable to set the NumberFormat property of the Range Class" error.

I can see that it is DIM'd as RANGE, but I think that is OK for what it is trying to do, but any help or suggestions are appreciated.

Option Explicit
Option Base 1
Dim MCCArray() As String
Dim i As Long
Dim bNewLine As Boolean
Const Delim = ","
Dim OffsetCols As Integer
Const TSYS_Max As Integer = 75
'Const TSYS_Max As Integer = 12
Dim SuccessionRange As String
Dim WholeString As String
Dim ParsedString As String
Dim MCC As String
Dim SaveMCC As String
Dim LastValue As Range
Dim InSuccession As Boolean

Public Sub UpdateCodes()
    Application.Cursor = xlWait
    With ThisWorkbook.Sheets("TSYS")
        Call MCCRange(ThisWorkbook.Sheets("Ascending Order").Range("MCCG_1"), .Range("Custom1"))
        Call MCCRange(ThisWorkbook.Sheets("Ascending Order").Range("MCCG_2"), .Range("Custom2"))
        Call MCCRange(ThisWorkbook.Sheets("Ascending Order").Range("MCCG_3"), .Range("Custom3"))
        Call MCCRange(ThisWorkbook.Sheets("Ascending Order").Range("MCCG_4"), .Range("Custom4"))
        Call MCCRange(ThisWorkbook.Sheets("Ascending Order").Range("MCCG_5"), .Range("Custom5"))
        Call MCCRange(ThisWorkbook.Sheets("Ascending Order").Range("MCCG_6"), .Range("Custom6"))
        Call MCCRange(ThisWorkbook.Sheets("Ascending Order").Range("MCCG_7"), .Range("Custom7"))
        Call MCCRange(ThisWorkbook.Sheets("Ascending Order").Range("MCCG_8"), .Range("Custom8"))
        Call MCCRange(ThisWorkbook.Sheets("Ascending Order").Range("MCCG_9"), .Range("Custom9"))
    End With
    Application.Cursor = xlDefault
End Sub

Sub MCCRange(InputRange As Range, PutRange As Range)
    Dim rCell As Range
    Dim myCount As Integer
    Dim MultiValue As Boolean
    OffsetCols = (InputRange.Range("A1").Column - 1) * -1
    WholeString = vbNullString
    Set LastValue = ActiveSheet.Range("A1")
    bNewLine = True
    SaveMCC = vbNullString: WholeString = vbNullString: SuccessionRange = vbNullString: ParsedString = vbNullString
    InSuccession = False
    For Each rCell In InputRange.Cells
        If rCell.Value <> 0 And Trim(rCell.Value) <> "" Then
            MCC = Trim(rCell.Offset(, OffsetCols).Value)
            
            If Len(MCC) > 4 Then
                MultiValue = True
            Else
                MultiValue = False
            End If
            
            If (rCell.Offset(-1).Address = LastValue.Address) And (MultiValue = False) Then
                ' add to group
                SuccessionRange = Left(SuccessionRange, 4) & "-" & MCC
                
            Else
                'begin new group
                Call ControlBreak
                SuccessionRange = MCC
            End If
        
            Set LastValue = rCell
        End If
    Next rCell
    Call ControlBreak
    If Len(WholeString) < 2 Then
        PutRange.Value = vbNullString
    Else
        WholeString = Right(WholeString, Len(WholeString) - 2)
        Call ParseArray
        If Len(ParsedString) > 255 Then
            PutRange.NumberFormat = "General"
        Else
[COLOR=#ff0000][SIZE=5][B]            PutRange.NumberFormat = "@"[/B][/SIZE][/COLOR]
        End If
        PutRange.Value = ParsedString
    End If
    
Exit_Here:
End Sub

Private Sub ControlBreak()
    WholeString = WholeString & "," & SuccessionRange
End Sub

Private Sub ParseArray()
    Dim CommaPos As Integer
    Dim TempString As String
    Dim Finished As Boolean
    
    TempString = WholeString
    Finished = False
    Do Until Finished = True
        CommaPos = InStrRev(TempString, Delim, TSYS_Max)
        If CommaPos > 0 Then
            ParsedString = ParsedString & Left(TempString, CommaPos - 1) & Chr(10)
        Else
            ParsedString = ParsedString & TempString
            Finished = True
        End If
        TempString = Right(TempString, Len(TempString) - CommaPos)
    Loop
End Sub

Function ConcRangeSave(InputRange As Range) As String
    
    Dim rCell As Range
    Dim myCount As Integer
    Dim MCCs As String
    OffsetCols = (InputRange.Range("A1").Column - 1) * -1
    myCount = 0
    
    For Each rCell In InputRange.Cells
        If rCell.Value <> 0 Then
            myCount = myCount + 1
            ReDim Preserve MCCArray(myCount)
            MCCArray(myCount) = Trim(rCell.Offset(, OffsetCols).Value)
        End If
    Next rCell
    If myCount = 0 Then
        ConcRange = vbNullString
        GoTo Exit_Here
    End If
  '  Call SortArray(MCCArray)
    
    myCount = 1
    bNewLine = True
    For i = 1 To UBound(MCCArray)
            If bNewLine = True Then
                ConcRange = ConcRange & MCCArray(i)
                bNewLine = False
            Else
                ConcRange = ConcRange & Delim & MCCArray(i)
            End If
            
            If Len(MCCArray(i)) > 4 Then
                myCount = myCount + 2
            Else
                myCount = myCount + 1
            End If
            If myCount > 15 Then
                bNewLine = True
                myCount = 1
                ConcRange = ConcRange & Chr(10)
            End If
    Next i
Exit_Here:
End Function

Public Sub ToggleHide()
    With ThisWorkbook
        .Sheets("TSYS").Visible = Not .Sheets("TSYS").Visible
        .Sheets("Ascending Order").Visible = Not .Sheets("Ascending Order").Visible
    End With
End Sub

 

[philwojo]

I think I might have figured something out with it to make it work, not gonna say fixed, but at least running. This was going on protected sheet and with it unprotected the code seemed to run fine. I added a line to unprotect, then reprotect the sheet to part of that code.

If anyone has any input still, feel free to post. I'm having the group using this test so I'm not 100% certain it is fixed yet.

Thanks,
Phil