Thanks a lot for your help! Unfortunately, I tested you code and I got the following error message: Run time error 9 Subscript out of range
It seems in fact that this line causes a problem: Set wbThis = ThisWorkbook Due to this problem, it seems that "Sheet1" is not recognized in my current workbook (I checked it via a debug print in my immediate window), I consulted this topic: Subscript out of range when referencing a worksheet in another workbook from a variable. That is why I modified "Set wbThis = ThisWorkbook" by "Set wbThis = ActiveWorkbook" After doing this modification and executing my macro (this time I do not get any error message), the excel file "Parc Vehicule Template.xls" is open but the instruction rng.Copy wsThat.Range("A1") is not executed, It means that my datas are not copied yet from my initial workbook open to my other workbook "Parc Vehicule Template.xls"
Thank you so much In advance for your help. Xavi
Set your objects and then work with them. Your life will become very easy. If I was to do the same thing, I would do it this way...
Is this what you are trying? (UNTESTED)
Sub copysheet1tofileParcVehiculeTemplatefortherest()
Dim wbThis As Workbook, wbThat As Workbook
Dim wsThis As Worksheet, wsThat As Worksheet
Dim rng As Range
Dim fName As String
Set wbThis = ThisWorkbook
Set wsThis = wbThis.Sheets("Sheet1")
Set rng = wsThis.Range("A1:AZ10000")
fName = "\\ingfs05\data1\GBS Center \52 Migration\ Files\Parc auto Template.xls"
If Not IsWorkBookOpen(fName) Then
Set wbThat = Workbooks.Open(fName)
Set wsThat = wbThat.Sheets("PV template for the rest")
rng.Copy wsThat.Range("A1")
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Also I see that Fname and Workbooks("Parc Vehicule Template.xls") are different. If that is intentional then I guess you are trying this?
Sub copysheet1tofileParcVehiculeTemplatefortherest()
Dim wbThis As Workbook, wbThat As Workbook, wbTmplt As Workbook
Dim wsThis As Worksheet, wsThat As Worksheet
Dim rng As Range
Dim fName As String
Set wbThis = ThisWorkbook
Set wsThis = wbThis.Sheets("Sheet1")
Set rng = wsThis.Range("A1:AZ10000")
fName = "\\ingfs05\data1\GBS Center \52 Migration\ Files\Parc auto Template.xls"
If Not IsWorkBookOpen(fName) Then
Set wbTmplt = Workbooks.Open(fName)
Set wbThat = Workbooks("Parc Vehicule Template.xls")
Set wsThat = wbThat.Sheets("PV template for the rest")
rng.Copy wsThat.Range("A1")
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Related
I am trying to write a macro that will prompt the user to open 2 workbooks and then loop through the worksheets in the 2 books comparing their contents and highlighting any differences in yellow. Each piece seems to be working on its own, but I cannot figure out how to set the workbook names as global variables to be used between the functions in my sub. Any help would be appreciated! :)
Public strFile1 As String
Public strFile2 As String
Public wbSource1 As Workbook
Public wbSource2 As Workbook
Public I As Integer
Sub DifferenceCheckBetweenBooks()
Call openIt
Call WorksheetLoop
End Sub
Function openIt()
strFile1 = Application.GetOpenFilename
Workbooks.Open strFile1
Set wbSource1 = Workbooks.Open(strFile1)
strFile2 = Application.GetOpenFilename
Workbooks.Open strFile2
Set wbSource2 = Workbooks.Open(strFile2)
End Function
Function WorksheetLoop()
Dim WS_Count As Integer
WS_Count = Workbooks(wbSource1).Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
Call compareBooks
Next I
End Function
Function compareBooks()
Dim mycell As Range
'For each cell in worksheet that is not the same as compared worksheet, color it yellow
For Each mycell In Workbooks(wbSource1).Worksheets(I).UsedRange
If Not mycell.Value = Workbooks(wbSource2).Worksheets(I).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.Color = vbYellow
Workbooks(wbSource2).Worksheets(I).Cells(mycell.Row, mycell.Column).Interior.Color = vbYellow
End If
Next
Workbooks(wbSource2).Worksheets(I).Select
End Function
I am getting the classic "subscript out of range error" which points to my wbSource1 variable as empty.
Don't do this
Workbooks.Open strFile1
Set wbSource1 = Workbooks.Open(strFile1)
you only need
Set wbSource1 = Workbooks.Open(strFile1)
And as SJR points out:
WS_Count = wbSource1.Worksheets.Count 'plus all other instances of this
You should really refactor your code to remove the globals and use parameters in your methods instead - that's a much safer approach.
Refactored to remove globals:
Sub DifferenceCheckBetweenBooks()
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = OpenIt("Choose first file")
If wb1 Is Nothing Then Exit Sub
Set wb2 = OpenIt("Choose second file")
If wb2 Is Nothing Then Exit Sub
CompareWorkbooks wb1, wb2
End Sub
Sub CompareWorkbooks(wb1 As Workbook, wb2 As Workbook)
Dim i As Long, sht1 As Worksheet, sht2 As Worksheet, c As Range, c2 As Range
For i = 1 To wb1.Worksheets.Count
Set sht1 = wb1.Worksheets(i)
Set sht2 = wb2.Worksheets(i)
For Each c In sht1.UsedRange.Cells
Set c2 = sht2.Range(c.Address)
If c.Value <> c2.Value Then
c.Interior.Color = vbYellow
c2.Interior.Color = vbYellow
End If
Next c
Next i
End Sub
Function OpenIt(msg As String) As Workbook
Dim strFile
strFile = Application.GetOpenFilename(Title:=msg)
If Len(strFile) > 0 Then Set OpenIt = Workbooks.Open(strFile)
End Function
I'm trying to write a macro that loops through all the Workbooks in a folder, and for each one sends an email with a range of rows that meet criteria. When I run the macro, it does this for the first file but stops at the second giving the error "Method 'Union' of object '_Global' failed", pointing to the line "Set rng2 = Union(rng2, row)". Below is the relevant code:
Sub LoopThroughFiles()
Dim File As String
File = Dir("FilePath\")
While (File <> "")
Set WorkBk = Workbooks.Open("FilePath\" & File)
Dim rng As Range
Dim row As Range
Dim rng2 As Range
Dim strbody As String
Dim OutApp As Object
Dim OutMail As Object
Set rng = Range("B52:I200")
For Each row In rng.Rows
If row.Columns(7) >= Date Then
If Not rng2 Is Nothing Then
'Below is the line that gets the error
Set rng2 = Union(rng2, row)
Else
Set rng2 = row
End If
End If
Next
'Email code removed
WorkBk.Close savechanges:=True
File = Dir()
Wend
End Sub
Any help would be greatly appreciated!
You're attempting to Union with the same range that you built using the previous Workbook. You need to clear the rng2 for each file you process:
WorkBk.Close savechanges:=True
Set rng2 = Nothing '<---You just closed the workbook this range was built with.
File = Dir()
I have 2 Excel workbooks. Both are in different folders.
I am copying data from one to another using a macro.
I observe a subscript out of range error...
Any insights in to this ?
Here is my code
Sub copydata()
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shttocopy As Worksheet
Dim wbname As String
' check if the file is open
ret = Isworkbookopen("C:\file1.xlsx")
If ret = False Then
' open file
Set wkbSource = Workbooks.Open("C:\file1.xlsx")
Else
'Just make it active
Workbooks("C:\file1.xlsx").Activate
End If
' check if the file is open
ret = Isworkbookopen("C:\File2.xlsx")
If ret = False Then
' open file
Set wkbDest = Workbooks.Open("C:\file2.xlsx")
Else
'Just make it active
Workbooks("file2.xlsx").Activate
End If
'perform copy
Set shttocopy = wkbSource.Sheets("filedata")
shttocopy.Copy wkbDest.Sheets(3)
End Sub
Function Isworkbookopen(filename As String)
Dim ff As Long, ErrNo As Long
Dim wkb As Workbook
Dim nam As String
wbname = filename
On Error Resume Next
ff = FreeFile()
Open filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: Isworkbookopen = False
Case 70: Isworkbookopen = True
Case Else: Error ErrNo
End Select
End Function
OK, I think I got it. Instead of .Activate, we'll just set the book if it's already open. We'll also reference the book by its file name, NOT path (as I had erroneously suggested in a comment above).
This worked for me:
Sub copydata()
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shttocopy As Worksheet
Dim wbname As String
' check if the file is open
ret = Isworkbookopen("C:\stack\file1.xlsx")
If ret = False Then
' open file
Set wkbSource = Workbooks.Open("C:\stack\file1.xlsx")
Else
'Just make it active
'Workbooks("C:\stack\file1.xlsx").Activate
Set wkbSource = Workbooks("file1.xlsx")
End If
' check if the file is open
ret = Isworkbookopen("C:\stack\File2.xlsx")
If ret = False Then
' open file
Set wkbDest = Workbooks.Open("C:\stack\file2.xlsx")
Else
'Just make it active
'Workbooks("C:\stack\file2.xlsx").Activate
Set wkbDest = Workbooks("file2.xlsx")
End If
'perform copy
Set shttocopy = wkbSource.Sheets("filedata")
shttocopy.Copy wkbDest.Sheets(3)
End Sub
Function Isworkbookopen(filename As String)
Dim ff As Long, ErrNo As Long
Dim wkb As Workbook
Dim nam As String
wbname = filename
On Error Resume Next
ff = FreeFile()
Open filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: Isworkbookopen = False
Case 70: Isworkbookopen = True
Case Else: Error ErrNo
End Select
End Function
Sub CopyData()
Dim Book As Workbook ' probably not needed
Set destinationFile = ThisWorkbook ' probably not needed
sourceFile = ("Add your source file name")
sourceFileLocation = ("add your source file location")
Workbooks.Open (sourceFileLocation + "\" + sourceFile)
Windows(sourceFile).Activate
Range("A1:X7215").Select 'Range Values can be changed depending upon the size of the data (total number of records and columns)
Selection.Copy
destinationFile.Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
Windows(sourceFile).Activate
ActiveWindow.Close
End Sub
This question already has answers here:
Subscript out of range error in this Excel VBA script
(3 answers)
Closed 9 years ago.
This code still gives me an out of subscript error
Sub importData2()
ChDir "C:\Users\Desktop\Java"
Dim filenum(0 To 10) As Long
filenum(0) = 052
filenum(1) = 060
filenum(2) = 064
filenum(3) = 068
filenum(4) = 070
filenum(5) = 072
filenum(6) = 074
filenum(7) = 076
filenum(8) = 178
filenum(9) = 180
filenum(10) = 182
Dim sh1 As Worksheet
Dim rng As Range
Set rng = Range(Selection, ActiveCell.SpecialCells(xlLastCell))
Dim wb As Workbook
Set wb = Application.Workbooks("30_graphs_w_Macro.xlsm")
Dim sh2 As Worksheet
Dim rng2 As Range
Set rng2 = Range("A69")
Dim wb2 As Workbook
For lngposition = LBound(filenum) To UBound(filenum)
Set wb2 = Application.Workbooks.Open(filenum(lngposition) & ".csv")
wb2.Worksheets(filenum(lngposition)).rng.Copy wb.Worksheets(filenum(lngposition)).rng2.Paste
Next lngposition
my_handler:
MsgBox "All done."
End Sub
This still gives me an out of subscript error on the line:
Set wb2 = Application.Workbooks(filenum(lngposition) & ".csv")
I avoided using .active and .select. .select.
Subscript out of Range would raise on that line if the required file is not already open.
Since it seems unlikely that you would already have 11 files open, you probably need to use the Open method to open the necessary workbook inside your loop.
Set wb2 = Application.Workbooks.Open(filenum(lngposition) & ".csv").
Updated your code
Sub importData2()
ChDir "C:\Users\Desktop\Java"
Dim filenum(0 To 10) As String
Dim wb As Workbook
Dim sh1 As Worksheet
Dim rng As Range
Dim wb2 As Workbook
Dim sh2 As Worksheet
Dim rng2 As Range
filenum(0) = "052"
filenum(1) = "060"
filenum(2) = "064"
filenum(3) = "068"
filenum(4) = "070"
filenum(5) = "072"
filenum(6) = "074"
filenum(7) = "076"
filenum(8) = "178"
filenum(9) = "180"
filenum(10) = "182"
'## What workbook is this referring to?? This might cause problems later...
Set rng = Range(Selection, ActiveCell.SpecialCells(xlLastCell))
Set rng2 = Range("A69")
Set wb = Application.Workbooks("30_graphs_w_Macro.xlsm")
For lngposition = LBound(filenum) To UBound(filenum)
Set wb2 = Application.Workbooks.Open(filenum(lngposition) & ".csv")
Set sh1 = wb.Worksheets(filenum(lngposition))
Set sh2 = wb2.Worksheets(1) 'A CSV file only has 1 worksheet.
sh2.rng.Copy Destination:=sh1.Range(rng2.Address)
Next lngposition
my_handler:
MsgBox "All done."
End Sub
You should definitely have Set on the line when you assign worksheets:
Set sh1 = Worksheets(filenum(lngPosition))
I am trying to create a simple Macro to copy data from a closed Excel file into the current one that I have open. So far I have created this
Sub CopyData()
Dim path As String
path = "C:\Users\sam\Coding\bk.xlsx"
Dim currentWb As Workbook
Set currentWb = ThisWorkbook
Dim openWb As Workbook
Set openWb = Workbooks.Open(path)
Dim openWs As Worksheet
Set openWs = openWb.Sheets("Sheet1")
currentWb.Activate
openWb.Activate
openWs.Range("A1:C2").Copy
currentWb.Range("A1").PasteSpecial
openWb.Close (False)
End Sub
But I get a RunTime Error 438 and upon debug it highlights the row "currentWb.Range("A1").PasteSpecial". I have search all over the place to find an answer but I haven't been successful. My question is, what am I missing?
Thank you in advance!
The problem is
currentWb.Range("A1").PasteSpecial
It should be
currentWb.Sheets("SomeSheet").Range("A1").PasteSpecial xlPasteAll
replace xlPasteAll with whatever you are trying.
Range object is not a part of Workbook but of Worksheet
Also you don't need to use .Activate. You code can be written as
Sub CopyData()
Dim path As String
Dim currentWb As Workbook, openWb As Workbook
Dim currentWs As Worksheet, openWs As Worksheet
path = "C:\Users\sam\Coding\bk.xlsx"
Set currentWb = ThisWorkbook
'~~> Change this applicable
Set currentWs = currentWb.Sheets("Sheet1")
Set openWb = Workbooks.Open(path)
Set openWs = openWb.Sheets("Sheet1")
openWs.Range("A1:C2").Copy
currentWs.Range("A1").PasteSpecial xlPasteValues
openWb.Close (False)
End Sub