Run-time error 9

[Sandy]

I am getting the following error at the asterisked line:-

"Run-time error'9': Subscript out of range".

Can someone point out why?

Sub TransferData()

Dim NewBookPath As String
Dim OldBookPath As String
Dim OldBook As String
Dim OldBookName As Workbook
Dim NewBook As String
Dim Lr As Long
Dim ThisBookName As String


ThisBookName = ThisWorkbook.Name
OldBook = Left(ThisBookName, 22) & Mid(ThisBookName, 26,
Len(ThisBookName) - 22)

NewBookPath = ThisWorkbook.Path
OldBookPath = NewBookPath & "\" & OldBook

NewBook = ActiveWorkbook.Name

Application.EnableEvents = False
Application.ScreenUpdating = False

*******
Set OldBookName = Workbooks(OldBook)
********

#####More code######

End Sub

Thanks
Sandy

 

[Joel]

Add a msgbox displaying the workbook name to make surre you are deleting the
corect name. Also make sure you have the .XLS as part of the book name.

 

[Sandy]

Hi Joel,
The following message box inserted just before the error line
MsgBox OldBook
produces the correct file name:-

"Personal Data Analyser-Sample Data-James Brown.xls"

Sandy

 

[Joel]

I would make the old book the active workbook then do this
msgbox(activeworkbook.name)

and compare the string you posted with the one returned from the msgbox
above. Put both strings into notepad on seperate lines and look closely.


also you can simplifiy the following line
from
OldBook = Left(ThisBookName, 22) & Mid(ThisBookName, 26,
Len(ThisBookName) - 22)

to
OldBook = Left(ThisBookName, 22) & Mid(ThisBookName, 26)


Mid() in VBA doesn't require the length. The worksheet function does
require the length.

 

[Sandy]

Hi Joel

Here is the (almost) entire code which works fine (until the if section is
inserted) but what I was trying to do was incorporate a test for the old
book being already open - in which case run the copy and paste code - if it
is closed then open it and then run the copy and paste code. (I have changed
the line you suggested).
I thought the "if" could go where I have commented it out.

Further - the reference to "Workbooks(OldName)" does not return an error
within the copy and paste sections - I am confused, hope it makes more sense
to you.

I got the basic code from here -
http://www.ozgrid.com/VBA/IsWorkbookOpen.htm.

Sub TransferData()

Dim NewBookPath As String
Dim OldBookPath As String
Dim OldBook As String
Dim OldBookName As Workbook
Dim NewBook As String
Dim Lr As Long
Dim SearchRngToCopy As Range
Dim DestCellRecord As Range
Dim ThisBookName As String


ThisBookName = ThisWorkbook.Name
OldBook = Left(ThisBookName, 22) & Mid(ThisBookName, 26)

NewBookPath = ThisWorkbook.Path
OldBookPath = NewBookPath & "\" & OldBook

NewBook = ActiveWorkbook.Name

Application.EnableEvents = False
Application.ScreenUpdating = False

' Set OldBookName = Workbooks(OldBook)
' If Workbooks(OldBook) Is Nothing Then
Workbooks.Open OldBookPath
' End If

'Copy Data
Windows(OldBook).Activate
ActiveWorkbook.Unprotect

With Workbooks(OldBook).Sheets("Records")
Lr = .Range("A65536").End(xlUp).Row
If Lr < 53 Then
Lr = 53
End If
Set RecordRngToCopy = .Range("A53:GM" & Lr)
End With

'Paste Data
Windows(NewBook).Activate
ActiveWorkbook.Unprotect

With Workbooks(NewBook).Sheets("Records")
.Unprotect Password:="xx"
Set DestCellRecord = .Range("A53")
RecordRngToCopy.Copy Destination:=DestCellRecord
.Protect Password:="xx"
End With


Windows(OldBook).Activate

Workbooks(OldBook).Close SaveChanges:=False

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

[Sandy]

Hi Joel,
After much searching - this works. I think the problem was because the book
to test for open was closed - if you see what I mean.
The main change is highlighted with asterisks.
Many thanks for your efforts.
Sandy

Sub TransferData()

Dim NewBookPath As String
Dim OldBookPath As String
Dim OldBook As String
Dim OldBookName As Workbook
Dim NewBook As String
Dim Lr As Long
Dim SearchRngToCopy As Range
Dim DestCellRecord As Range
Dim ThisBookName As String


ThisBookName = ThisWorkbook.Name
OldBook = Left(ThisBookName, 22) & Mid(ThisBookName, 26)

NewBookPath = ThisWorkbook.Path
OldBookPath = NewBookPath & "\" & OldBook

NewBook = ActiveWorkbook.Name

Application.EnableEvents = False
Application.ScreenUpdating = False


*********************************
On Error GoTo OpenWorkBook:
Workbooks(OldBook).Activate

OpenWorkBook:
If Err.Number = 9 Then
Workbooks.Open OldBookPath
End If

On Error GoTo 0
*********************************


'Copy Data
Windows(OldBook).Activate
ActiveWorkbook.Unprotect

With Workbooks(OldBook).Sheets("Records")
Lr = .Range("A65536").End(xlUp).Row
If Lr < 53 Then
Lr = 53
End If
Set RecordRngToCopy = .Range("A53:GM" & Lr)
End With


'Paste Data
Windows(NewBook).Activate
ActiveWorkbook.Unprotect

With Workbooks(NewBook).Sheets("Records")
.Unprotect Password:="xx"
Set DestCellRecord = .Range("A53")
RecordRngToCopy.Copy Destination:=DestCellRecord
.Protect Password:="xx"
End With

Windows(OldBook).Activate

Workbooks(OldBook).Close SaveChanges:=False

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub