I'm trying to copy worksheets from one workbook to another - arrays

I'm trying to copy several complete worksheets from one workbook to another. I have recorded a macro to create the code, but when I implement it into my main workbook I get the Subscript Out of Range error (runtime error ‘9’). My research for this question reveals how to copy data from one workbook to another, but not multiple worksheets.
Here is the code. It is supposed to copy the worksheets in Therm Cal Compiler.xlsm and paste them into SN1813016 - Copy.xlsx after the fourth sheet:
Windows("Therm Cal Compiler.xlsm").Activate
Sheets(Array("Thermal Calibration", "Therm_R1_-_0uA_-25C", "Therm_R1_-_0uA_0C", _
"Therm_R1_-_0uA_23C", "Therm_R1_-_0uA_40C", "Therm_R1_-_0uA_50C", _
"Therm_R1_-_0uA_60C", "Therm_R1_-_0uA_65C", "Therm_R1_-_0uA_70C")).Select
Sheets(Array("Thermal Calibration", "Therm_R1_-_0uA_-25C", "Therm_R1_-_0uA_0C", _
"Therm_R1_-_0uA_23C", "Therm_R1_-_0uA_40C", "Therm_R1_-_0uA_50C", _
"Therm_R1_-_0uA_60C", "Therm_R1_-_0uA_65C", "Therm_R1_-_0uA_70C")).Copy Before _
:=Workbooks("SN1813016 - Copy.xlsx").Sheets(5)
Both the Therm Cal Compiler.xlsm and SN1813016 - Copy.xlsx are open, and the error occurs on the second array command,
Sheets(Array("Thermal Calibration",…)).Copy Before _
:=Workbooks("SN1813016 - Copy.xlsx").Sheets(5).
Any ideas?
Thanks

If your destination workbook does not have 5 sheets, this will cause that error.
You should use After:= instead. Also, the Activate and Selects are not required.
Try this
Workbooks("Therm Cal Compiler.xlsm").Worksheets(Array( _
"Thermal Calibration", _
"Therm_R1_-_0uA_-25C", _
"Therm_R1_-_0uA_0C", _
"Therm_R1_-_0uA_23C", _
"Therm_R1_-_0uA_40C", _
"Therm_R1_-_0uA_50C", _
"Therm_R1_-_0uA_60C", _
"Therm_R1_-_0uA_65C", _
"Therm_R1_-_0uA_70C")).Copy _
After:=Workbooks("SN1813016 - Copy.xlsx").Sheets(4)

Related

Getting Run-Time error '1004' Is my formula perhaps too long or can I fix the coding?

So I wrote up an Array formula which works fine on my excel, but when converting it to VBA I'm getting an error: Unable to set the FormulaArray property of the Range class. I'm not sure why I'm getting this issue. Please see the code here:
Selection.FormulaArray = _
"=IF(IF(AND(OR(RC[-14]<>R[-1]C[-14],RC[-15]<>R[-1]C[-15]),Pay_Periods!R2C10<>0),MAX(IF(Pay_Periods!R2C3:R250C3>=Pay_Periods!R1C10+(14*Pay_Periods!R3C10),IF(Pay_Periods!R2C2:R250C2<=Pay_Periods!R1C10+(14*Pay_Periods!R3C10),Pay_Periods!R2C3:R250C3))),MAX(IF((Pay_Periods!R2C3:R250C3>=Sheet1!RC[-10])*(IF(AND(Sheet1!RC[-14]=Sheet1!R[-1]C[-14],Sheet1!R[-1]C[-10]<Sheet1!RC[" & _
"-10]+14),Pay_Periods!R2C3:R250C3<(RC[-10]+14),IF(AND(RC[-14]=R[-1]C[-14],RC[-15]=R[-1]C[-15]),Pay_Periods!R2C3:R250C3<R[-1]C[-10],1))),Pay_Periods!R2C3:R250C3,"""")))=0,"""",IF(AND(OR(RC[-14]<>R[-1]C[-14],RC[-15]<>R[-1]C[-15]),Pay_Periods!R2C10<>0),MAX(IF(Pay_Periods!R2C3:R250C3>=Pay_Periods!R1C10+(14*Pay_Periods!R3C10),IF(Pay_Periods!R2C2:R250C2<=Pay_Periods!R1C10+" & _
"(14*Pay_Periods!R3C10),Pay_Periods!R2C3:R250C3))),MAX(IF((Pay_Periods!R2C3:R250C3>=Sheet1!RC[-10])*(IF(AND(Sheet1!RC[-14]=Sheet1!R[-1]C[-14],Sheet1!RC[-15]=Sheet1!R[-1]C[-15],Sheet1!R[-1]C[-10]<Sheet1!RC[-10]+14),Pay_Periods!R2C3:R250C3<(RC[-10]+14),IF(AND(RC[-14]=R[-1]C[-14],RC[-15]=R[-1]C[-15]),Pay_Periods!R2C3:R250C3<R[-1]C[-10],1))),Pay_Periods!R2C3:R250C3,"""")" & _
")))" & _
""
By the way I copied it exactly how the macro itself recorded it so you may notice some spaces. I'm thinking it could just be too long, but it seems weird that writing it in the cell gets it fine, but not in the vba form. If anyone can help it would be much appreciated! I'm attempting to have this formula self insert by code and copy paste values so the excel doesn't have to keep loading in information.
Here is how the formula looks normally:
=IF(IF(AND(OR(C2<>C1,B2<>B1),Pay_Periods!$J$2<>0),MAX(IF(Pay_Periods!$C$2:$C$250>=Pay_Periods!$J$1+(14*Pay_Periods!$J$3),IF(Pay_Periods!$B$2:$B$250<=Pay_Periods!$J$1+(14*Pay_Periods!$J$3),Pay_Periods!$C$2:$C$250))),MAX(IF((Pay_Periods!$C$2:$C$250>=Sheet1!G2)*(IF(AND(Sheet1!C2=Sheet1!C1,Sheet1!G1<Sheet1!G2+14),Pay_Periods!$C$2:$C$250<(G2+14),IF(AND(C2=C1,B2=B1),Pay_Periods!$C$2:$C$250<G1,1))),Pay_Periods!$C$2:$C$250,"")))=0,"",IF(AND(OR(C2<>C1,B2<>B1),Pay_Periods!$J$2<>0),MAX(IF(Pay_Periods!$C$2:$C$250>=Pay_Periods!$J$1+(14*Pay_Periods!$J$3),IF(Pay_Periods!$B$2:$B$250<=Pay_Periods!$J$1+(14*Pay_Periods!$J$3),Pay_Periods!$C$2:$C$250))),MAX(IF((Pay_Periods!$C$2:$C$250>=Sheet1!G2)*(IF(AND(Sheet1!C2=Sheet1!C1,Sheet1!B2=Sheet1!B1,Sheet1!G1<Sheet1!G2+14),Pay_Periods!$C$2:$C$250<(G2+14),IF(AND(C2=C1,B2=B1),Pay_Periods!$C$2:$C$250<G1,1))),Pay_Periods!$C$2:$C$250,""))))
Then ctrl+shift+enter naturally
I went ahead and built a custom solution just for you. Here, you'll see I broke up your formula into smaller parts and substitute them back together (just like the good 'ol days back in algebra class).
Also note, that I don't use the Selection object as you do in your question. I recommend working with Ranges directly rather than using .Select, Selection. or .Activate and so on. So In my example below I assume the range you have "Selected" is A1 on the first worksheet.
strFormula = "=IF(IF(AND(OR(C2<>C1,B2<>B1),Pay_Periods!$J$2<>0),MAX(W_W),MAX(X_X))=0,""""," & _
"IF(AND(OR(C2<>C1,B2<>B1),Pay_Periods!$J$2<>0),MAX(Y_Y),MAX(Z_Z)))"
strFormulaW_W = "IF(Pay_Periods!$C$2:$C$250>=Pay_Periods!$J$1+(14*Pay_Periods!$J$3)," & _
"IF(Pay_Periods!$B$2:$B$250<=Pay_Periods!$J$1+(14*Pay_Periods!$J$3),Pay_Periods!$C$2:$C$250))"
strFormulaX_X = "IF((Pay_Periods!$C$2:$C$250>=Sheet1!G2)*(IF(AND(Sheet1!C2=Sheet1!C1,Sheet1!G1<Sheet1!G2+14)," & _
"Pay_Periods!$C$2:$C$250<(G2+14),IF(AND(C2=C1,B2=B1),Pay_Periods!$C$2:$C$250<G1,1))),Pay_Periods!$C$2:$C$250,"""")"
strFormulaY_Y = "IF(Pay_Periods!$C$2:$C$250>=Pay_Periods!$J$1+(14*Pay_Periods!$J$3),IF(Pay_Periods!$B$2:$B$250<=" & _
"Pay_Periods!$J$1+(14*Pay_Periods!$J$3),Pay_Periods!$C$2:$C$250))"
strFormulaZ_Z = "IF((Pay_Periods!$C$2:$C$250>=Sheet1!G2)*(IF(AND(Sheet1!C2=Sheet1!C1,Sheet1!B2=Sheet1!B1," & _
"Sheet1!G1<Sheet1!G2+14),Pay_Periods!$C$2:$C$250<(G2+14),IF(AND(C2=C1,B2=B1),Pay_Periods!$C$2:$C$250<G1,1))),Pay_Periods!$C$2:$C$250,"""")"
With ThisWorkbook.Worksheets(1).Range("A1")
.FormulaArray = strFormula
.Replace "W_W", strFormulaW_W
.Replace "X_X", strFormulaX_X
.Replace "Y_Y", strFormulaY_Y
.Replace "Z_Z", strFormulaZ_Z
End With

Open the latest file

I have an Access form with the drawing number D-A1ER-1378-1601-0 listed which is also stored in a file folder.
I use the code below to open the pdf drawing, which works fine.
Public Sub OpenDWG()
Dim strFile As String
Dim PathPDF As String
On Error GoTo Failure
PathPDF = DLookup("[FilePath]", "[SettingsDrawingFilePathTbl]", "ID = 4")
strFile = PathPDF & "\" & Screen.ActiveControl & ".pdf"
If Len(Dir(strFile)) Then
FollowHyperlink strFile
Else
MsgBox "No Document found for this Drawing Number, check Engineering Drawing Search File path in the Settings Tab and / drawing download files"
End If
Exit Sub
Failure:
MsgBox Err.Description
Err.Clear
End Sub
How do I adjust the strfile name
strFile = PathPDF & "\" & Screen.ActiveControl & ".pdf"
to get the form to open only the most recent file when a new version of the drawing is dropped into the folder. ie D-A1ER-1378-1601-0(2) will be the newest revision.
I would like to add a comment, but I don't have enough points ot comment.
I think that you can use the Dir function to get all files beginning with the same characters, or with wild cards, etc. I'll have to look into how exactly to do this. You could populate an array with these, and use code to scan the array to determine the latest file. Or you could populate a temporary table amd then use the table contents as the course to a combo box to have the user select the desired file, sorted with the latest one on top.
If I get a chance, I'll conjure up some sample code an post it.

Autofilter Criteria with Array

I have been looking to find a solution and cant find anything online that fully explains what is going on. I looked at some other posts but they all seem to fall a bit short.
When I run this bit of code it works perfectly (as it was recorded).
ActiveSheet.Range("$A$1:$AL$1002").AutoFilter Field:=17, Criteria1:=Array( _
"73578", "78759", "78765"), Operator:=xlFilterValues
But then when I try to make it more robust it fails. I want to change the Criteria1 argument to an already stored array.
I am trying to get the following to work.
ActiveSheet.Range("$A$1:$AL$1002").AutoFilter Field:=17, _
Criteria1:=Array(StoredArray.Values), Operator:=xlFilterValues
I have the array stored and I manipulate it anyway but I have yet to get anything to work. I have also tried to create a string to be exactly like the recorded macro but that does not work either.
Dim StoredArrayString as Variant
StoredArrayString = "73578"", ""78759"", ""78765"
ActiveSheet.Range("$A$1:$AL$1002").AutoFilter Field:=17, _
Criteria1:=StoredArrayString, Operator:=xlFilterValues
Thanks for the help here I have spent lots of time on MSDN trying to research this issue but can't find a solution.
I think your issue is with how you're defining your array. Try this instead.
Dim StoredArrayString As Variant
StoredArrayString = Array("73578", "78759", "78765")
ActiveSheet.Range("$A$1:$AL$1002").AutoFilter Field:=17, _
Criteria1:=StoredArrayString, Operator:=xlFilterValues
Starting with:
and run:
Sub Macro7()
Dim ary(1 To 3) As String
ary(1) = "Alice"
ary(2) = "Boris"
ary(3) = "James"
ActiveSheet.Range("$A$1:$D$22").AutoFilter Field:=3, Criteria1:=ary, Operator:=xlFilterValues
End Sub
will produce:

Visual basic 6 issue with combobox

I have created a forum in vb6 and made connection with a database in access,everything went perfect.
my problem is in my form there is 2 combobox one to select Number and other to get me other numbers (watch the video to understand )
anyway the first combo is working and the second combo is working too but after selecting different number from the first combo i don't get anything in the second combo.anyway i know i just miss something in the code something very stupid
i have uploaded a video so you can see my problem, thanks in advance.
Private Sub Form_Load()
liaison
Do Until rspatient.EOF
Me.npa.AddItem rspatient.Fields(0)
rspatient.MoveNext
Loop
End Sub
Private Sub npa_Click()
rspatient.MoveFirst
Dim cr As String
cr = "npation ='" & npa & "'"
rspatient.Find cr
nom = rspatient.Fields(1)
prenom = rspatient.Fields(3)
rshospita.MoveFirst
nh.Clear
While rshospita.EOF = False
If UCase(rshospita.Fields(14)) = UCase(npa) Then
nh.AddItem rshospita.Fields(0)
End If
rshospita.MoveNext
Wend
End Sub
video for more detail :
https://www.youtube.com/watch?v=Tidm18_tvp0
The simplest possible reason for your problem is that you don't have any hospital records associated with your second patient. Check that first.
However, your code is also a bit convoluted. A simpler way to do what you want is to use Filter instead of Find. Filter restricts your recordset to only those records which match the filter, so you can simply iterate the filtered recordset the same way you do the whole one (rspatient). Something like this:
Private Sub npa_Click()
With rshospita
.Filter = ".Fields(14) = '" & npa & "'"
.MoveFirst
nh.Clear
Do Unitl .EOF
nh.AddItem .Fields(0)
.MoveNext
End With
End Sub

Excel - VBA Question. Need to access data from all excel files in a directory without opening the files

So I have a "master" excel file that I need to populate with data from excel files in a directory. I just need to access each file and copy one line from the second sheet in each workbook and paste that into my master file without opening the excel files.
I'm not an expert at this but I can handle some intermediate macros. The most important thing I need is to be able to access each file one by one without opening them. I really need this so any help is appreciated! Thanks!
Edit...
So I've been trying to use the dir function to run through the directory with a loop, but I don't know how to move on from the first file. I saw this on a site, but for me the loop won't stop and it only accesses the first file in the directory.
Folder = "\\Drcs8570168\shasad\Test"
wbname = Dir(Folder & "\" & "*.xls")
Do While wbname <> ""
i = i + 1
ReDim Preserve wblist(1 To i)
wblist(i) = wbname
wbname = Dir(FolderName & "\" & "*.xls")
How does wbname move down the list of files?
You dont have to open the files (ADO may be an option, as is creating links with code, or using ExecuteExcel4Macro) but typically opening files with code is the most flexible and easiest approach.
Copy a range from a closed workbook (ADO)
ExecuteExcel4Macro
Links method
But why don't you want to open the files - is this really a hard constraint?
My code in Macro to loop through all sheets that are placed between two named sheets and copy their data to a consolidated file pulls all data from all sheets in each workbook in a folder together (by opening the files in the background).
It could easily be tailored to just row X of sheet 2 if you are happy with this process
I just want to point out: You don't strictly need VBA to get values from a closed workbook. You can use a formula such as:
='C:\MyPath\[MyBook.xls]Sheet1'!$A$3
You can implement this approach in VBA as well:
Dim rngDestinationCell As Range
Dim rngSourceCell As Range
Dim xlsPath As String
Dim xlsFilename As String
Dim sourceSheetName As String
Set rngDestinationCell = Cells(3,1) ' or Range("A3")
Set rngSourceCell = Cells(3,1)
xlsPath = "C:\MyPath"
xlsFilename = "MyBook.xls"
sourceSheetName = "Sheet1"
rngDestinationCell.Formula = "=" _
& "'" & xlsPath & "\[" & xlsFilename & "]" & sourceSheetName & "'!" _
& rngSourceCell.Address
The other answers present fine solutions as well, perhaps more elegant than this.
brettdj and paulsm4 answers are giving much information but I still wanted to add my 2 cents.
As iDevlop answered in this thread ( Copy data from another Workbook through VBA ), you can also use GetInfoFromClosedFile().
Some bits from my class-wrapper for Excel:
Dim wb As Excel.Workbook
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.DisplayAlerts = False ''# prevents dialog boxes
xlApp.ScreenUpdating = False ''# prevents showing up
xlApp.EnableEvents = False ''# prevents all internal events even being fired
''# start your "reading from the files"-loop here
Set wb = xlApp.Workbooks.Add(sFilename) '' better than open, because it can read from files that are in use
''# read the cells you need...
''# [....]
wb.Close SaveChanges:=False ''# clean up workbook
''# end your "reading from the files"-loop here
''# after your're done with all files, properly clean up:
xlApp.Quit
Set xlApp = Nothing
Good luck!
At the start of your macro add
Application.ScreenUpdating = false
then at the end
Application.ScreenUpdating = True
and you won't see any files open as the macro performs its function.

Resources