Getting subscript out of range error

B

brap1987

New Member
Joined
Jun 25, 2015
Messages
8
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
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
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
 
Upvote 0
baitmaster said:
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
Click to expand...

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
 
Last edited:
Upvote 0
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?
 
Upvote 0
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)
 
Upvote 0
Code: 
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
 
Upvote 0
brap1987 said:
so at the point the code crashes:
- does it contain the worksheet "Summary Sheet Arch"? no it contains Summary Sheet
Click to expand...
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Subscript out of range error
2
Replies
12
Views
499
Domenic
D
P
  • Solved
Subscript out of range error 9 on windows activate
2 3
Replies
20
Views
671
MARK858
MARK858
B
  • Question
Subscript Out of Range - Update Sheet Name (VBA)
2
Replies
10
Views
666
kevin9999
K
J
  • Question
VBA Macros running slow out of nowhere
Replies
3
Views
194
mumps
mumps
D
  • Solved
Run-time error 9, Subscript out of range - Copying sheet from closed workbook to active workbook as new sheet
Replies
9
Views
290
dvward
D

Forum statistics

Threads
1,214,605
Messages
6,120,473
Members
448,967
Latest member
visheshkotha

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