PDA

View Full Version : Solved: Cycling through Workbooks



jo15765
01-08-2012, 07:44 AM
I have the following code which I combined 3 individual modules to make this one enormous code! The only problem I have with this code is that it cycles through each varBook before going to the Next statement. Ideally I want it to grab the 1st varBook, run the code, then go to the Next statement, run the 2nd set of code, then go to the next statement, then run the 3rd set of code, then cycle back to the beginning for the next varBook.

Public Sub Testing()
Dim Varbooks
Dim varBook
Dim wb As Excel.Workbook

Application.DisplayAlerts = False

Varbooks = Array("Fire", "Ice", "Wind", "Mountain", "Sun")

For Each varBook In Varbooks
Set wb = Workbooks.Open(Location of workbook & varBook)
With wb
.SaveAs Filename:="Enter File Name here"
End With
Next

Dim fileName1
Dim fileName2
Dim strPath1 As String
Dim strpath2 As String
Dim whichPath As String
Dim CurrentPath As String
CurrentPath = ActiveWorkbook.Path
On Error GoTo ErrorCatch

fileName1 = "Enter file Name Here"
fileName2 = "Enter file Name Here"

varWorksheets = Array(fileName1, fileName2)

Dim strPathArr()
ReDim strPathArr(1 To 2)
MsgBox varBook
For Each varBook In Varbooks
strPathArr(1) = "1st location to check for the varbook" & varBook
strPathArr(2) = "2nd location to check for the varbook" & varBook

For Each varWorksheet In varWorksheets
Set wb = Nothing
whichPath = InWhichPathArr(strPathArr, varBook, varWorksheet)
If Len(Trim(whichPath)) > 0 Then
Set wb = Workbooks.Open(Filename:=whichPath & "\" & varBook & varWorksheet)
End If
If Not wb Is Nothing Then
Dim wks As Worksheet, qt As QueryTable
For Each wks In wb.Worksheets
For Each qt In wks.QueryTables
qt.Refresh BackgroundQuery:=False
Next qt
Next wks
Set qt = Nothing
Set wks = Nothing
Application.DisplayAlerts = False
wb.SaveAs Filename:="Location and filename to save as"
End If
Next varWorksheet
GoTo ExitMacro

ErrorCatch:
MsgBox Err.Description

ExitMacro:
On Error GoTo 0

Next

Set wb = Workbooks.Open(Name & Location of workbook wantingn to open)

For Each varBook In Varbooks
On Error Resume Next
Dim ws As Object
Set ws = Nothing: Set ws = wb.Sheets(varBook)
On Error GoTo 0
If Not ws Is Nothing Then
ActiveWorkbook.SaveAs Filename:="Location and filename to save as"
End If

Next varBook


I want it to run all the code on "Fire", then once all of that is done, jump back to the top to run "Ice"

Can someone point out the error in my ways?!

Rob342
01-10-2012, 01:00 PM
Jo

Instead of using the array you will need to put each of the files in a loop
This is a bit of code i use to grab data from a closed Wb copy certain parts then paste it into a main database.
Might give you some ideas to modify your code as req

Option Explicit
Option Private Module
Sub UpdateDetails()
'// Update From JCR Template Main Data sheet for all team members
Dim wbD As Workbook ' this is where the data is coming from
Dim wbM As Workbook ' this is where the data is going to Master Copy
Dim wsM As Worksheet
Dim wsD As Worksheet
Dim Files(1 To 4) As String
Dim FilePath As String
Dim FileNum As Integer
Dim LastRow As Long
Dim LastRowData As Long

Application.DisplayAlerts = False
'Application.EnableEvents = False
Application.ScreenUpdating = False

For FileNum = 1 To 4
FilePath = "C:\Documents and Settings\Administrator\My Documents\JOB CARD RETURNS\"

Files(1) = "JCR TEMPLATE RS.xls"
Files(2) = "JCR TEMPLATE PA.xls"
Files(3) = "JCR TEMPLATE JK.xls"
Files(4) = "JCR TEMPLATE AM.xls"

Workbooks.Open (FilePath & Files(FileNum))

Set wsD = Worksheets("Main") ' JCR TEMPLATE RS,PA,JK,AM set the worksheet in JCR template
Set wbM = Workbooks("JCR MASTER DATABASE.xls") ' JCR MASTER DataBase Pivot Reports
Set wsM = wbM.Worksheets("DATABASE") ' JCR MASTER SHEET DATABASE

LastRowData = wsD.Cells(wsD.Rows.Count, "A").End(xlUp).Row ' JCR TEMPLATE Data
LastRow = wsM.Cells(wsM.Rows.Count, "A").End(xlUp).Row ' JCR MASTER Data

'// Open up the workbooks Files 1 - 4 and copy the data into the JCR master database

With wsD
.Range("A2:H" & LastRowData).Copy
End With
With wsM
wsM.Cells(LastRow + 1, "A").PasteSpecial Paste:=xlPasteAll
End With
Next

ThisWorkbook.Activate
Call CloseAll
Worksheets("PTABLE1").Select

Application.DisplayAlerts = True
'Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sub CloseAll()
'// Close all but the active workbook
Dim wkbk As Workbook

Application.ScreenUpdating = False
'Application.EnableEvents = False
Application.DisplayAlerts = False
For Each wkbk In Application.Workbooks
If wkbk.Name <> ActiveWorkbook.Name Then
wkbk.Close savechanges:=True 'or make it False
End If
Next
Application.DisplayAlerts = True
'Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

jo15765
01-10-2012, 01:26 PM
I understand what your code is doing...I just can't seem to wrap my mind around how to get my code to cycle through each workbook individually so that I can have it perform each part in a series....

If I changed my varBooks (removed the array) and declared a variable called WB1, WB2 and then assigned the values from the array to WB1 and WB2 would that work, or am I still trying the same thing I have above?

mdmackillop
01-10-2012, 02:17 PM
Can you post a workbook containing the original coding.

jo15765
01-10-2012, 02:32 PM
Attached is a workbook with my coding inside

mdmackillop
01-10-2012, 02:37 PM
That contains your final code, not the individual units you are combining.

jo15765
01-10-2012, 02:43 PM
Your right, sorry.

mdmackillop
01-10-2012, 03:13 PM
This is general principle only. Pass the name of the workbook to each of the processing routines, something like the following

Option Explicit
Public Sub AllSubs()
Dim varBooks
Dim varbook
Dim WB As Excel.Workbook

Application.DisplayAlerts = False

varBooks = Array("Fire", "Ice", "Wind", "Mountain", "Sun")

For Each varbook In varBooks
Call One(varbook)
Call Two(varbook)
Call Three(varbook)
Next varbook
End Sub

Public Sub One(varbook)
Dim WB As Excel.Workbook
Set WB = Workbooks.Open("C:\Test\" & varbook)
With WB
.SaveAs Filename:="C:\Completed" & "_Monday"
End With
End Sub

Public Sub Two(varbook)
Dim WB As Excel.Workbook
Dim fileName1
Dim fileName2
Dim varWorksheet
Dim varWorksheets
Dim varbook
Dim varBooks
Dim strPath1 As String
Dim strpath2 As String
Dim whichPath As String
Dim CurrentPath As String
CurrentPath = ActiveWorkbook.Path
On Error GoTo ErrorCatch

fileName1 = "Workbook1"
fileName2 = "Workbook2"


varWorksheets = Array(fileName1, fileName2)

Dim strPathArr()
ReDim strPathArr(1 To 2)
MsgBox varbook
strPathArr(1) = "C:\Daily\" & varbook
strPathArr(2) = "C:\Monthly\" & varbook

For Each varWorksheet In varWorksheets
Set WB = Nothing
whichPath = InWhichPathArr(strPathArr, varbook, varWorksheet)
If Len(Trim(whichPath)) > 0 Then
Set WB = Workbooks.Open(Filename:=whichPath & "\" & varbook & varWorksheet)
End If
If Not WB Is Nothing Then
Dim wks As Worksheet, qt As QueryTable
For Each wks In WB.Worksheets
For Each qt In wks.QueryTables
qt.Refresh BackgroundQuery:=False
Next qt
Next wks
Set qt = Nothing
Set wks = Nothing
Application.DisplayAlerts = False
WB.SaveAs Filename:="C:\Completed" & "_Monday"
End If
Next varWorksheet
GoTo ExitMacro

ErrorCatch:
MsgBox Err.Description

ExitMacro:
On Error GoTo 0
End Sub
Sub Three(varbook)
Dim WB As Excel.Workbook
Set WB = Workbooks.Open("C:\Master")
On Error Resume Next
Dim ws As Object
Set ws = Nothing: Set ws = WB.Sheets(varbook)
On Error GoTo 0
If Not ws Is Nothing Then
ActiveWorkbook.SaveAs Filename:="C:\Completed" & "_Monday"
End If
End Sub
Function InWhichPathArr(ByRef strPathArr() As Variant, varProgram As Variant, varbook As Variant) As String
Dim i As Integer
For i = LBound(strPathArr) To UBound(strPathArr)
If Len(Dir(strPathArr(i) & "\" & varProgram & varbook)) Then
InWhichPathArr = strPathArr(i)
Exit Function
End If
Next i
InWhichPathArr = vbNullString
End Function
Function InWhichPath(strPath1 As String, strpath2 As String, varProgram As Variant, varbook As Variant) As String
If Len(Dir(strPath1 & "\" & varProgram & varbook)) Then
InWhichPath = strPath1
ElseIf Len(Dir(strpath2 & "\" & varProgram & varbook)) Then
InWhichPath = strpath2
Else
InWhichPath = vbNullString
End If
End Function

jo15765
01-10-2012, 03:22 PM
I haven't tested the code above, but will that allow it to cycle Fire through Module one, then Module two, then Module three before moving onto Ice?

Or does that just alleviate me having to declare the varBooks at the beginning of each module?

mdmackillop
01-11-2012, 03:30 AM
I haven't tested the code above, but will that allow it to cycle Fire through Module one, then Module two, then Module three before moving onto Ice?

Yes

jo15765
01-11-2012, 01:56 PM
Works to Perfection!!! Thank you for the help!