Getting subscript out of range error

[brap1987]

hey guys i am getting this subscript out of range error on my a program in excel set up at my work. The problem is that it was set up a long time ago and it has been converted many times and now it barely works. I fixed most of the errors on it but i am still getting an error on this substring. I am not too good with code so any help would be appreciated. Thanks in advance. ps im not sure how to paste it in its orginal format so bare with me



Sub printacrch()
'Archive data sheets
Application.ScreenUpdating = False
'Start Archeive Process
'Check if folder exists for data
path1 = ThisWorkbook.Sheets(dspa).Cells(59, 3)
dirchk = Dir(path1, 16)
'If not create folder for data
If dirchk = "" Then
MkDir (path1)
Else
End If
'Check if Excel file for er already exits
path2 = ThisWorkbook.Sheets(dspa).Cells(60, 3)
filechk = Dir(path2, 0)
'if file does not exist create if
If filechk = "" Then
Set newbook = Workbooks.Add
With newbook
.SaveAs Filename:=Workbooks("airsheetnew version.xlsm").Sheets(dspa).Cells(60, 3)
End With
'Set rename old summary to 2
Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(8, 37) = 2
Else
'or open the file
Workbooks.Open ThisWorkbook.Sheets(dspa).Cells(60, 3)
'if 1st time through rename old summary sheet
If Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(8, 37) = 1 Then
ActiveWorkbook.Sheets("Summary Sheet Arch").Name = Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(5, 34)
Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(8, 37) = 2
Else
'if not 1st time delete old sheet
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("Summary Sheet Arch").Delete
Application.DisplayAlerts = True
End If
End If

'copy data sheet#1 into file
archxl = Workbooks("airsheetnew version.xlsm").Sheets(dspa).Cells(57, 5)
Workbooks("airsheetnew version.xlsm").Sheets(dspa).Copy Before:=Workbooks(archxl).Sheets(1)
'Error trap for archiving same worksheet numbers
On Error GoTo 987
'rename sheet to test number
Workbooks(archxl).Sheets(1).Name = Workbooks("airsheetnew version.xlsm").Sheets(dspa).Cells(7, 7)
'end error handling
On Error GoTo 0
'Add Delta P to 1st Column in Archive
Workbooks(archxl).Sheets(1).Cells(17, 1) = "Del P"
'Make Delta P Col Visible, centered and 2 decimals
Workbooks(archxl).Sheets(1).Range("a18:a51").Font.ColorIndex = xlAutomatic
Workbooks(archxl).Sheets(1).Range("a18:a51").HorizontalAlignment = xlCenter
Workbooks(archxl).Sheets(1).Range("a18:a51").NumberFormat = "0.00"
'copy summary sheet to archive
'summary sheet
Workbooks("airsheetnew version.xlsm").Sheets("Summary Sheet").Copy Before:=Workbooks(archxl).Sheets(1)
'rename summary sheet
Workbooks(archxl).Sheets(1).DrawingObjects("summary1").Delete
Workbooks(archxl).Sheets(1).DrawingObjects("summary2").Delete
Workbooks(archxl).Sheets(1).Name = "Summary Sheet Arch"
'close archive workbook
ActiveWorkbook.Close (True)
'if data is to be sent ot engineer do it
'Check if to send or not
If ThisWorkbook.Sheets("data input").CheckBoxes("sendeng").Value = xlOn Then
'send to subroutine to send data
If ThisWorkbook.Sheets("Data Input").Cells(28, 26) = 1 Then
GoTo 87
Else
engsenddata
End If
Else
End If
87
'reset archive button
ThisWorkbook.Sheets("data input").DrawingObjects(pa).Font.ColorIndex = 48
ThisWorkbook.Sheets("Data Input").DrawingObjects(pa).Enabled = False
'check if all archive buttons are off then shut off all button
If ActiveSheet.DrawingObjects("pa1").Enabled = False And ActiveSheet.DrawingObjects("pa2").Enabled = False And ActiveSheet.DrawingObjects("pa3").Enabled = False And ActiveSheet.DrawingObjects("pa4").Enabled = False And ActiveSheet.DrawingObjects("pa5").Enabled = False Then
ActiveSheet.DrawingObjects("paall").Font.ColorIndex = 48
ActiveSheet.DrawingObjects("paall").Enabled = False
Else
End If
'activate screen updating
Application.ScreenUpdating = True
'exit subroutine before error handler
Exit Sub
'Rename Error Handling routine
987
'rename sheet to test number + date code for repeat test numbers
Workbooks(archxl).Sheets(1).Name = Workbooks("airsheetnew version.xlsm").Sheets(dspa).Cells(61, 3)
Resume Next
End Sub

 

[baitmaster]

where is it crashing? When you run it and get the error message, you have the choice to Debug, hit this and tell us which line is highlighted in yellow

 

[brap1987]

where is it crashing? When you run it and get the error message, you have the choice to Debug, hit this and tell us which line is highlighted in yellow

Else
'or open the file
Workbooks.Open ThisWorkbook.Sheets(dspa).Cells(60, 3)
'if 1st time through rename old summary sheet
If Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(8, 37) = 1 Then
ActiveWorkbook.Sheets("Summary Sheet Arch").Name = Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(5, 34) Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(8, 37) = 2
Else
'if not 1st time delete old sheet
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("Summary Sheet Arch").Delete
Application.DisplayAlerts = True
End If
End If

 

[brap1987]

i'm not sure why its not keeping my orginal format... is there a better way i can do it.

 

[baitmaster]

OK

so at the point the code crashes:
- what is the name of the activeworkbook, i.e. the workbook in focus (not necessarily the one containing this code)?
- does it contain the worksheet "Summary Sheet Arch"?
- is there a workbook open that is called "airsheetnew version.xlsm"?
- does that file contain a worksheet named "Data Input"?
- what is the value in cell AH5 of that worksheet?

 

[baitmaster]

i'm not sure why its not keeping my orginal format... is there a better way i can do it.

put CODE tags around it. See the hashtag above the message box?

it does this

 

[brap1987]

so at the point the code crashes:
- what is the name of the activeworkbook, i.e. the workbook in focus (not necessarily the one containing this code)? airsheetnew version.xlsm
- does it contain the worksheet "Summary Sheet Arch"? no it contains Summary Sheet
- is there a workbook open that is called "airsheetnew version.xlsm"? yes this is open.
- does that file contain a worksheet named "Data Input"? yes
- what is the value in cell AH5 of that worksheet? =LEFT(CONCATENATE("Sum","-",F24),15)

 

[brap1987]

Sub printacrch()
'Archive data sheets
Application.ScreenUpdating = False
'Start Archeive Process
'Check if folder exists for data
path1 = ThisWorkbook.Sheets(dspa).Cells(59, 3)
dirchk = Dir(path1, 16)
'If not create folder for data
If dirchk = "" Then
    MkDir (path1)
Else
End If
'Check if Excel file for er already exits
path2 = ThisWorkbook.Sheets(dspa).Cells(60, 3)
filechk = Dir(path2, 0)
'if file does not exist create if
If filechk = "" Then
    Set newbook = Workbooks.Add
        With newbook
            .SaveAs Filename:=Workbooks("airsheetnew version.xlsm").Sheets(dspa).Cells(60, 3)
        End With
        'Set rename old summary to 2
        Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(8, 37) = 2
Else
'or open the file
    Workbooks.Open ThisWorkbook.Sheets(dspa).Cells(60, 3)
    'if 1st time through rename old summary sheet
    If Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(8, 37) = 1 Then
        ActiveWorkbook.Sheets("Summary Sheet Arch").Name = Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(5, 34)
        Workbooks("airsheetnew version.xlsm").Sheets("Data Input").Cells(8, 37) = 2
    Else
        'if not 1st time delete old sheet
        Application.DisplayAlerts = False
        ActiveWorkbook.Sheets("Summary Sheet Arch").Delete
        Application.DisplayAlerts = True
    End If
End If
        
'copy data sheet#1 into file
archxl = Workbooks("airsheetnew version.xlsm").Sheets(dspa).Cells(57, 5)
Workbooks("airsheetnew version.xlsm").Sheets(dspa).Copy Before:=Workbooks(archxl).Sheets(1)
'Error trap for archiving same worksheet numbers
On Error GoTo 987
'rename sheet to test number
Workbooks(archxl).Sheets(1).Name = Workbooks("airsheetnew version.xlsm").Sheets(dspa).Cells(7, 7)
'end error handling
On Error GoTo 0
'Add Delta P to 1st Column in Archive
Workbooks(archxl).Sheets(1).Cells(17, 1) = "Del P"
'Make Delta P Col Visible, centered and 2 decimals
Workbooks(archxl).Sheets(1).Range("a18:a51").Font.ColorIndex = xlAutomatic
Workbooks(archxl).Sheets(1).Range("a18:a51").HorizontalAlignment = xlCenter
Workbooks(archxl).Sheets(1).Range("a18:a51").NumberFormat = "0.00"
'copy summary sheet to archive
'summary sheet
Workbooks("airsheetnew version.xlsm").Sheets("Summary Sheet").Copy Before:=Workbooks(archxl).Sheets(1)
'rename summary sheet
Workbooks(archxl).Sheets(1).DrawingObjects("summary1").Delete
Workbooks(archxl).Sheets(1).DrawingObjects("summary2").Delete
Workbooks(archxl).Sheets(1).Name = "Summary Sheet Arch"
'close archive workbook
ActiveWorkbook.Close (True)
'if data is to be sent ot engineer do it
'Check if to send or not
If ThisWorkbook.Sheets("data input").CheckBoxes("sendeng").Value = xlOn Then
    'send to subroutine to send data
    If ThisWorkbook.Sheets("Data Input").Cells(28, 26) = 1 Then
        GoTo 87
    Else
        engsenddata
    End If
Else
End If
87
'reset archive button
ThisWorkbook.Sheets("data input").DrawingObjects(pa).Font.ColorIndex = 48
ThisWorkbook.Sheets("Data Input").DrawingObjects(pa).Enabled = False
'check if all archive buttons are off then shut off all button
If ActiveSheet.DrawingObjects("pa1").Enabled = False And ActiveSheet.DrawingObjects("pa2").Enabled = False And ActiveSheet.DrawingObjects("pa3").Enabled = False And ActiveSheet.DrawingObjects("pa4").Enabled = False And ActiveSheet.DrawingObjects("pa5").Enabled = False Then
    ActiveSheet.DrawingObjects("paall").Font.ColorIndex = 48
    ActiveSheet.DrawingObjects("paall").Enabled = False
Else
End If
'activate screen updating
Application.ScreenUpdating = True
'exit subroutine before error handler
Exit Sub
'Rename Error Handling routine
987
'rename sheet to test number + date code for repeat test numbers
Workbooks(archxl).Sheets(1).Name = Workbooks("airsheetnew version.xlsm").Sheets(dspa).Cells(61, 3)
Resume Next
End Sub

 

[baitmaster]

so at the point the code crashes:
- does it contain the worksheet "Summary Sheet Arch"? no it contains Summary Sheet

sounds like thats your problem right there. The reason for my questions was because something about these items is not configured correctly. If you try to use an object that doesn't exist then your code will fail, so you need to confirm that everything you are using does exist. Find the thing that doesn't and you should find your answer

 

[Michael M]

As Baitmaster has already mentioned.....When using workbook and sheet names the syntax must be identical !
Computers are just dumb tin boxes and follow our every command EXACTLY.
Even if the sheet names is spelt correctly, but there is an extra space in the name for instance, the code will simply see it as not the correct name and "crash"
Sometimes it's better to copy the sheet name directly from the sheet tab itself.....and paste it into the code, that way you eliminate a lot of your "Subscript out of range" errors