Mysterious Run-time error '9'

C

cstimart

Well-known Member
Joined
Feb 25, 2010
Messages
1,180
On occasion, I run my macro and receive this error that indicates "Subscript out of range"....with no option to Debug. I then close the excel document, re-open and run the macro again and no issue what-so-ever. :confused:

Any ideas?
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
Not without seeing the macro. If you have an error handler in it, I suggest you turn it off to debug the problem.
 
Upvote 0
cstimart,

Can we see your macro code?

At the beginning of your posted code, enter the following without the * character:
[*code]

'Your code goes here.

At the end of your posted code, enter the following without the * character:
[*/code]
 
Upvote 0
I'll post it in a bit...I just need to "clean" it of any business related info. :wink:
 
Upvote 0
It's a HUGE bunch of data and looks like crap, as everything Left Justifies when I paste it in here. :(
 
Upvote 0
We don't (yet) need data, just code, and if you use the code tags it should look fine.
 
Upvote 0
Use Code Tags.

Type

[*code]

without the *

Paste the code

Type

[*/code]

without the *
 
Upvote 0
Here it is

Code: 
Public i As Integer
Public x As Integer
Public c0l0r As Integer 'color
Public col(4) As String 'columns
Public upperRow As Integer
    Public UR As Integer
Public lowerRow As Integer
    Public LR As Integer
Public Depttitle As String
Public Deptcnt As Integer
Public Depttarget As String
Public Role(27) As String
Public sVal As Integer
Public aVal As Integer

Sub Create_Report()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled

    Dim upr(28) As Integer
    Dim lwr(28) As Integer
    Dim t As Integer
    Dim d8 As String
        d8 = Format(Date, "mm.dd.yy")

Sheets("Sheet1").Select

LR = Range("B" & Rows.Count).End(xlUp).Row
    Range("E1") = "Code 2"
For t = 2 To LR
        If Range("D" & t) = "Job Title 1" Then
            Range("E" & t) = "(J1)"
        ElseIf Range("D" & t) = "Job Title 2" Then
            Range("E" & t) = "(J2)"
        ElseIf Range("D" & t) = "Job Title 3" Then
            Range("E" & t) = "(J3)"
        ElseIf Range("D" & t) = "Job Title 4" Then
            Range("E" & t) = "(J4)"
        ElseIf Range("D" & t) = "Job Title 5" Then
            Range("E" & t) = "(J5)"
        ElseIf Range("D" & t) = "Job Title 6" Then
            Range("E" & t) = "(J6)"
        ElseIf Range("D" & t) = "Job Title 7" Then
            Range("E" & t) = "(J7)"
        End If
Next t

ActiveSheet.Unprotect
Call Sort_Data
ActiveSheet.Protect

'Determine top/bottom of groups
        upr(1) = 2
        upperRow = 1
        lowerRow = Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To lowerRow
            If Range("A" & i) <> Range("A" & i + 1) Then
                lwr(upperRow) = i        'set lower row #
                   upperRow = upperRow + 1
                upr(upperRow) = i + 1  'set upper row #
            End If
    Next i

'Assign Ranges
    For i = 1 To 27
        Role(i) = "B" & upr(i) & ": D" & lwr(i)
    Next i

'Add New Sheet
    Sheets.Add Before:=Sheets("Sheet1")
    ActiveSheet.Name = "Sheet2"
        ActiveWindow.Zoom = 70
    Range("A:A").ColumnWidth = 1
    Range("B:B, H:H, N:N").ColumnWidth = 32
    Range("C:C, I:I, O:O").ColumnWidth = 6.75
    Range("D:D, J:J, P:P").ColumnWidth = 8.25
    Range("E:E, K:K").ColumnWidth = 6
    Columns("Q:Q").ColumnWidth = 7
    Range("F:G, L:M").ColumnWidth = 1
    Range("C:E, I:K, O:Q").HorizontalAlignment = xlCenter
    Call Clear_Lines

'Copy to Chart

    col(1) = "B"
    col(2) = "C"
    col(3) = "D"
    col(4) = "E"

'Role 1
    Depttitle = [Title19]
    Deptcnt = [Role19]
    x = 19
    lowerRow = 10
    c0l0r = 5
Call Lead

'Role 2
        Depttitle = [Title05]
        Deptcnt = [Role05]
        Depttarget = [Target05]
        x = 5
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 1
        c0l0r = 5
Call Members

'Role 3
        Depttitle = [Title08]
        Deptcnt = [Role08]
        Depttarget = [Target08]
        x = 8
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'Role 4
        Depttitle = [Title17]
        Deptcnt = [Role17]
        Depttarget = [Target17]
        x = 17
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'Role 5
        Depttitle = [Title12]
        Deptcnt = [Role12]
        Depttarget = [Target12]
        x = 12
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 1
Call Members

'Role 6
        Depttitle = [Title10]
        Deptcnt = [Role10]
        Depttarget = [Target10]
        x = 10
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 10
Call Members

    Range("C" & lowerRow + 2 & ":F" & lowerRow + 2).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

    Range(col(1) & lowerRow + 2).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

'Role 7
        Depttitle = [Title22]
        Deptcnt = [Role22]
        x = 22
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 3
        c0l0r = 5
Call Lead

    Range(col(1) & lowerRow + 2).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

'Role 8
        Depttitle = [Title24]
        Deptcnt = [Role24]
        Depttarget = [Target24]
        x = 24
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'Role 9
        Depttitle = [Title25]
        Deptcnt = [Role25]
        Depttarget = [Target25]
        x = 25
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'Role 10
        Depttitle = [Title26]
        Deptcnt = [Role26]
        Depttarget = [Target26]
        x = 26
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'Role 11
        Depttitle = [Title27]
        Deptcnt = [Role27]
        Depttarget = [Target27]
        x = 27
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'HOLD VALUE FOR DETERMINING PRINT RANGE
t = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row

    col(1) = "H"
    col(2) = "I"
    col(3) = "J"
    col(4) = "K"

''Role 11
    'Create Title Bar
        Depttitle = [Title13]
        Deptcnt = [Role13]
        x = 13
        lowerRow = 3
        c0l0r = 1
Call Lead

    Range(col(1) & lowerRow + 1).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

'Role 12
        Depttitle = [Title03]
        Deptcnt = [Role03]
        x = 3
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 1
Call Lead

    Range(col(1) & lowerRow + 1 & ":" & col(1) & lowerRow + 2).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

'Role 13
        Depttitle = [Title20]
        Deptcnt = [Role20]
        x = 20
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 3
        c0l0r = 5
Call Lead

'Role 14
        Depttitle = [Title15]
        Deptcnt = [Role15]
        Depttarget = [Target15]
        x = 15
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 1
        c0l0r = 5
Call Members

'Role 15
        Depttitle = [Title16]
        Deptcnt = [Role16]
        Depttarget = [Target16]
        x = 16
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

    Range("F9:F" & lowerRow + 1).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

    Range("G" & lowerRow + 2 & ":H" & lowerRow + 2).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

    Range(col(1) & lowerRow + 2).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

'Role 16
        Depttitle = [Title18]
        Deptcnt = [Role18]
        x = 18
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 3
        c0l0r = 5
 Call Lead

'Role 17
         Depttitle = [Title01]
        Deptcnt = [Role01]
        Depttarget = [Target01]
        x = 1
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 1
        c0l0r = 5
Call Members

'Role 18
        Depttitle = [Title02]
        Deptcnt = [Role02]
        Depttarget = [Target02]
        x = 2
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'HOLD FOR DETERMINING PRINT RANGE
    lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row
        If lowerRow > t Then
            t = lowerRow
        End If

    col(1) = "N"
    col(2) = "O"
    col(3) = "P"
    col(4) = "Q"

    Range("C9:N9").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

'Role 19
        Depttitle = [Title23]
        Deptcnt = [Role23]
        x = 23
        lowerRow = 10
        c0l0r = 5
Call Lead

    Range(col(1) & lowerRow + 2).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

    Range("M" & lowerRow + 2 & ":N" & lowerRow + 2).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

'Role 20
        Depttitle = [Title21]
        Deptcnt = [Role21]
        x = 21
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 3
        c0l0r = 5
Call Lead

'Role 21
        Depttitle = [Title06]
        Deptcnt = [Role06]
        Depttarget = [Target06]
        x = 6
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 1
        c0l0r = 5
Call Members

'Role 22
        Depttitle = [Title07]
        Deptcnt = [Role07]
        Depttarget = [Target07]
        x = 7
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'Role 23
        Depttitle = [Title09]
        Deptcnt = [Role09]
        Depttarget = [Target09]
        x = 9
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'Role 24
        Depttitle = [Title04]
        Deptcnt = [Role04]
        Depttarget = "n/a"
        x = 4
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

'Role 25
        Depttitle = [Title11]
        Deptcnt = [Role11]
        Depttarget = [Target11]
        x = 11
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 2
        c0l0r = 5
Call Members

    Range("L9:L" & lowerRow + 1).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

    Range("M" & lowerRow + 2 & ":N" & lowerRow + 2).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With
    
    Range(col(1) & lowerRow + 2).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With

'Role 26
        Depttitle = [Title14]
        Deptcnt = [Role14]
        Depttarget = [Target14]
        x = 14
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 3
        c0l0r = 7
Call Members
 
'HOLD FOR DETERMINING PRINT RANGE
    lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row
        If lowerRow > t Then
            t = lowerRow
        End If

'SET PRINT RANGE, MARGINS, ETC...
    ActiveSheet.PageSetup.PrintArea = "$B$2:$Q$" & t
    With ActiveSheet.PageSetup
        .CenterHeader = "&C&B&""Arial""&Team Members"
        .LeftFooter = "&""Arial""&08&F"
        .RightFooter = _
        "&R&B&U&8&""Calibri""Secondary Role in parentheses." & Chr(10) & "&B&U(J1) Job Title 1" & Chr(10) & "(J2) Job Title 2" & Chr(10) & "(J3) Job Title 3" & Chr(10) & "(J4) Job Title 4" & Chr(10) & "(J5) Job Title 5" & Chr(10) & "(J6) Job Title 6" & Chr(10) & "(J7) Job Title 7"
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.17)
        .TopMargin = Application.InchesToPoints(0.79)
        .BottomMargin = Application.InchesToPoints(0.19)
        .HeaderMargin = Application.InchesToPoints(0.23)
        .FooterMargin = Application.InchesToPoints(0.03)
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    
ActiveSheet.PageSetup.LeftHeaderPicture.Filename = "C:\My Documents\Logo1.jpg"
    ActiveSheet.PageSetup.LeftHeader = "&G"
ActiveSheet.PageSetup.RightHeaderPicture.Filename = "C:\My Documents\Logo2.jpg"
    ActiveSheet.PageSetup.RightHeader = "&G"


Range("B2") = "Total Dept Members (" & [Total] & ")"
Range("B3") = "Dept1(" & [Actual] - ([Actual03] + [Actual04] + [Actual26]) & ")"
Range("B4") = "Dept2 (" & [Actual03] + [Actual04] + [Actual26] & ")"
Range("B5") = "Vacant (" & WorksheetFunction.CountIf(Sheets("Sheet2").UsedRange, "Vacant") & ")"

c0l0r = 1
Call Format_Grid

'Delete Members Sheet
    Application.DisplayAlerts = False
            Sheets("Sheet1").Select
            ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True

'Delete VBA Module
    Dim vbCom As Object
        Set vbCom = Application.VBE.ActiveVBProject.VBComponents
        vbCom.Remove VBComponent:=vbCom.Item("Module1")

'Save Final Product
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:="C:\Chart " & d8 & ".xls", FileFormat:=xlNormal
    
End Sub

Sub Sort_Data()
'Shift Columns
    Sheets("Sheet1").Select
        Range("A:A,C:C").Select
        Range("C1").Activate
            Selection.Insert Shift:=xlToRight
        Columns("C:C").Select
            Selection.Cut
            Range("A1").Select
            ActiveSheet.Paste
        Columns("G:G").Select
            Selection.Cut
            Range("D1").Select
            ActiveSheet.Paste
        Range("C:C,G:G").Select
            Range("G1").Activate
            Selection.Delete Shift:=xlToLeft

'Sort Members by Role/Name
    Columns("A:E").Select
    Selection.SORT Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
End Sub

Sub Format_LeadHeader_RowLeft()
Application.DisplayAlerts = False
    With Selection
        .HorizontalAlignment = xlCenter
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
Application.DisplayAlerts = True
End Sub

Sub Format_LeadHeader_RowRight()
Application.DisplayAlerts = False
    With Selection
        .HorizontalAlignment = xlCenter
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
Application.DisplayAlerts = True
End Sub

Sub Format_Lead1Left()
Application.DisplayAlerts = False
    Selection.MergeCells = True
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
Application.DisplayAlerts = True
End Sub

Sub Format_Lead1Right()
Application.DisplayAlerts = False
    With Selection
        .HorizontalAlignment = xlCenter
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlNone
        .Weight = xlThin
        .ColorIndex = 15
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
Application.DisplayAlerts = True
End Sub

Sub Format_Lead2Left()
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
End Sub

Sub Format_Lead2Right()
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
End Sub

Sub Format_Role_Header()
    Selection.HorizontalAlignment = xlCenter
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
        With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
End Sub

Sub Format_Role()
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Sub Clear_Lines()
    Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 2
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 2
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 2
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 2
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 2
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 2
    End With
End Sub

Sub Inside_Lines()
    Range(col(1) & upperRow & ":" & col(2) & lowerRow).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
    Range(col(3) & upperRow & ":" & col(4) & lowerRow).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
End Sub

Sub Inside_Lines1()
    Range(col(3) & upperRow & ":" & col(4) & lowerRow).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With
End Sub

Sub Format_Grid()
    Range("B3:B5").Select
    Selection.HorizontalAlignment = xlCenter
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
        .ColorIndex = c0l0r
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 15
    End With

    Range("B2").Select
    Selection.HorizontalAlignment = xlCenter
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 10
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = c0l0r
    End With
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
End Sub

Sub Lead()
'Create Title Bar
        Range(col(1) & lowerRow).Select
            ActiveCell.Offset(0, 0) = Depttitle & " (" & Deptcnt & ")"
            ActiveCell.Offset(0, 2) = "Role Start"
'Format Title Bar
            Range(col(1) & lowerRow & " :" & col(2) & lowerRow).Select
                    Call Format_LeadHeader_RowLeft
            Range(col(3) & lowerRow & ":" & col(4) & lowerRow).Select
                    Call Format_LeadHeader_RowRight
'Copy Value from Source
        Sheets("Sheet1").Select
            Range(Role(x)).Copy
        Sheets("Sheet2").Select
'Paste to Chart
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 1
        Range(col(1) & lowerRow).Select
            Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
'Vacant
        UR = lowerRow
        LR = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row
        sVal = Deptcnt
        aVal = LR - UR + 1
            Do While aVal < sVal
                LR = LR + 1
                Range(col(1) & LR) = "Vacant"
                Range(col(3) & LR) = "n/a"
                    Range(col(1) & LR & ":" & col(4) & LR).Select
                    Selection.Font.ColorIndex = 3
                aVal = aVal + 1
            Loop
'Format Team Member
If Deptcnt = 1 Then
            Range(col(1) & lowerRow & ":" & col(2) & lowerRow).Select
                Call Format_Lead1Left
           Range(col(3) & lowerRow & ":" & col(4) & lowerRow).Select
                Call Format_Lead1Right
Else
                Application.DisplayAlerts = False
                upperRow = lowerRow
                lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row
            Range(col(1) & upperRow & ":I" & lowerRow).Select
                Call Format_Lead2Left
            Range(col(3) & upperRow & ":K" & lowerRow).Select
                Call Format_Lead2Right
                    For i = upperRow To lowerRow
                        Range(col(1) & i & ":I" & i).Select
                            With Selection
                                .HorizontalAlignment = xlLeft
                                .MergeCells = True
                            End With
                        Range(col(3) & i & ":K" & i).Select
                            With Selection
                                .HorizontalAlignment = xlCenter
                                .MergeCells = True
                            End With
                    Next i
    Application.DisplayAlerts = True
End If

    If Depttitle = [Title22] Then
        Range(col(1) & lowerRow + 1).Select
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 3
        End With
    End If
End Sub

Sub Members()
    Dim st0p As Boolean

'Create Title Bar
        Range(col(1) & lowerRow).Select
            ActiveCell.Offset(0, 0) = Depttitle & " (" & Deptcnt & ")"
            ActiveCell.Offset(0, 1) = "2nd"
            ActiveCell.Offset(0, 2) = "Role Start"
            ActiveCell.Offset(0, 3) = "Target"

'Format Title Bar
       Range(col(1) & lowerRow & ":" & col(4) & lowerRow).Select
                Call Format_Role_Header
'Copy Value from Source
        Sheets("Sheet1").Select
        Range(Role(x)).Copy
        Sheets("Sheet2").Select
'Paste to Chart
        lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row + 1
        Range(col(1) & lowerRow).Select
            Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
'Add Target
                   upperRow = lowerRow
                    st0p = False
                    Do While st0p = False
                        If Range(col(3) & upperRow) <> "" Then
                                    Range(col(4) & upperRow) = Depttarget
                                   upperRow = upperRow + 1
                        Else
                            st0p = True
                        End If
                    Loop
'Find Range
           upperRow = lowerRow
           lowerRow = Sheets("Sheet2").Range(col(1) & Rows.Count).End(xlUp).Row
'Vacant
        sVal = Deptcnt
        aVal = lowerRow - upperRow + 1
            Do While aVal < sVal
                lowerRow = lowerRow + 1
                Range(col(1) & lowerRow) = "Vacant"
                Range(col(3) & lowerRow) = "n/a"
                Range(col(4) & lowerRow) = "n/a"
                    Range(col(1) & lowerRow & ":" & col(4) & lowerRow).Select
                    Selection.Font.ColorIndex = 3
                aVal = aVal + 1
            Loop
'Set Range
            Range(col(1) & upperRow & ":" & col(4) & lowerRow).Select
    Call Format_Role
        If upperRow = lowerRow Then
            Call Inside_Lines1
        Else
            Call Inside_Lines
        End If

If Depttitle = [Title10] Or Depttitle = [Title27] Or Depttitle = [Title16] _
        Or Depttitle = [Title02] Or Depttitle = [Title11] Or Depttitle = [Title14] Then
        Exit Sub
        Else
            Range(col(1) & lowerRow + 1).Select
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = 3
            End With
        End If
End Sub
 
Upvote 0
"Subscript out of range" ... with no option to Debug
Click to expand...
Do you have the option in the VBE set to Break on Unhandled Errors?

Is the code in a Sheet module or ThisWorkbook module? If so, move it to a code module.
 
Upvote 0
Yes, the code is in Module1 and I have the option in the VBE set to Break on Unhandled Errors.

The frustrating thing is that the error doesn't appear on a consistent basis.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
Spreadsheet Crashing
Replies
3
Views
170
Michael M
Michael M
C
  • Question
Run-time error -2147319767 (80028029) ... SOMETIMES
Replies
1
Views
107
footoo
F
R
  • Solved
Worksheet CodeName as type Worksheet
Replies
7
Views
193
StephenCrump
S
M
  • Question
Macro: Copy/rename sheet and create hyperlink. Error. Are shared documents not macro friendly?
Replies
1
Views
216
Micron
M
P
  • Solved
Subscript out of range error 9 on windows activate
2 3
Replies
20
Views
784
MARK858
MARK858

Forum statistics

Threads
1,215,523
Messages
6,125,322
Members
449,218
Latest member
Excel Master

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top