Getting Run Time Error 5 on String?

[Paul_Hossler]

This might be a band-aide to avoid the error, but the result looks OK

I did change / reformat the macros a little to make it easier for me to follow

Option Explicit

Dim ActivityList As Range, slackList As Range, CriticalList As Range, DurationList As Range
Dim PredecessorList As Range, EarlyStartList As Range, SuccessorList As Range

Sub RunCPM()
    Dim NumRows As Long, k As Long
    Call ForwardPass
    Call BackwardPass
    
    With ActiveSheet
        Set ActivityList = Range("A7")
        Set slackList = Range("I7")
        Set CriticalList = Range("J7")
        Set DurationList = Range("D7")
            With ActivityList
                NumRows = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
            End With
        For k = 1 To NumRows
        slackList.Offset(k, 0).Formula = "=RC[-1]-RC[-3]"
        CriticalList.Offset(k, 0).Formula = "=IF(RC[-1]=0,""YES"",)"
        Next
    End With
End Sub
Sub ForwardPass()
    Dim i As Long, k As Long, NumRows As Long
    Dim ArgString As String
    
    With ActiveSheet
        Set ActivityList = Range("A7"): Set PredecessorList = Range("C7")
        Set EarlyStartList = Range("E7"): Set SuccessorList = Range("K7")
        
        With ActivityList
            NumRows = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
       End With
       For k = 1 To NumRows
            ArgString = vbNullString
            
            If Len(PredecessorList.Offset(k, 0)) > 0 Then
                For i = 1 To k - 1
                    If InStr(1, PredecessorList.Offset(k, 0), ActivityList.Offset(i, 0)) > 0 Then
                        ArgString = ArgString & EarlyStartList.Offset(i, 1).Address & ","
                    End If
                Next
            End If
            
            If Len(ArgString) = 0 Then
                ArgString = 0
            End If
            
            EarlyStartList.Offset(k, 0).Formula = "=MAX(" & ArgString & ")"
            EarlyStartList.Offset(k, 1).Formula = "=RC[-2]+RC[-1]"
            
        Next k
    End With
End Sub

Sub BackwardPass()
    Dim i As Long, k As Long, n As Long, NumRows As Long
    Dim ArgString As String, SucString As String
    
    Set ActivityList = Range("A7")
    Set PredecessorList = Range("C7")
    Set EarlyStartList = Range("E7")
    Set SuccessorList = Range("K7")
    
    With ActiveSheet
        With ActivityList
             NumRows = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
        End With
        
        EarlyStartList.Offset(NumRows, 3).Formula = "=" & EarlyStartList.Offset(NumRows, 1).Address
        EarlyStartList.Offset(NumRows, 2).Formula = "=RC[+1]-RC[-3]"
        
        For n = 1 To NumRows - 1
            ArgString = vbNullString
            SucString = vbNullString
         
            k = NumRows - n
            
            For i = k + 1 To NumRows
                If InStr(1, PredecessorList.Offset(i, 0), ActivityList.Offset(k, 0)) > 0 Then
                    Debug.Print n & " -- " & k & " -- " & ArgString
                    ArgString = ArgString & EarlyStartList.Offset(i, 2).Address & ","
                    SucString = SucString & ActivityList.Offset(i, 0).Address & ","","","
                End If
            Next I
        
            If Len(ArgString) > 0 Then
                ArgString = Left(ArgString, Len(ArgString) - 1)
                EarlyStartList.Offset(k, 3).Formula = "=MIN(" & ArgString & ")"
                EarlyStartList.Offset(k, 2).Formula = "=RC[+1]-RC[-3]"
                SuccessorList.Offset(k, 0).Value = "=concatenate(" & SucString & ")"
            End If
        Next n
    End With
End Sub