Solved: Combining VBA Code

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

jo15765

Thread Starter
Joined
Oct 11, 2011
Messages
307
I have currently been running these two modules separately...is there a way to combine them into one module and run together?
Code:
Public Sub Monday_1()
    Dim Varbooks
    Dim varBook
    Dim wb As Excel.Workbook
    Varbooks = Array("Test1", "Test2")
        For Each varBook In Varbooks
            Set wb = Workbooks.Open(Filename:="L:\Monday\" & varBook)
            Run "RefreshOnOpen"
            With wb
                .SaveAs Filename:="L:\Test_Folder\" & "_" & VBA.Left(ActiveWorkbook.Name, VBA.InStrRev(.Name, ".") - 1) & "_" & VBA.Format(Date, "mmddyyyy") & ".xls"
                .Close False
            End With
        Next varBook
End Sub
Public Sub Monday_2()
    Dim Varbooks
    Dim varBook
    Dim varPrograms
    Dim varprogram
    Dim fileName1
    Dim fileName2
    Dim wb As Excel.Workbook
    Dim strPath1 As String
    Dim strpath2 As String
    Dim whichPath As String
    Dim CurrentPath As String
    
    CurrentPath = ActiveWorkbook.Path
    On Error GoTo ErrorCatch

    fileName1 = "_RainStorm.xls"
    fileName2 = "_SnowStorm.xls"
    varPrograms = Array("Test1", "Test2")
    Varbooks = Array(fileName1, fileName2)
    
    Dim strPathArr()
    ReDim strPathArr(1 To 2)
    
    For Each varprogram In varPrograms
        strPathArr(1) = "L:\Monday\" & varprogram
        strPathArr(2) = "L:\Monday\" & varprogram & "_New"
        
        For Each varBook In Varbooks
            Set wb = Nothing
            whichPath = InWhichPathArr(strPathArr, varprogram, varBook)
            If Len(Trim(whichPath)) > 0 Then
                Set wb = Workbooks.Open(Filename:=whichPath & "\" & varprogram & varBook)
            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:="L:\Test_Folder\" & VBA.Left(ActiveWorkbook.Name, VBA.InStrRev(wb.Name, ".") - 1) & "_" & VBA.Format(Date, "mmddyyyy") & ".xls"
                Application.DisplayAlerts = True
                wb.Close False
            End If
        Next varBook
    Next varprogram
    GoTo ExitMacro
    
ErrorCatch:
MsgBox Err.Description

ExitMacro:
On Error GoTo 0
End Sub
 

jo15765

Thread Starter
Joined
Oct 11, 2011
Messages
307
I just took out the End Sub and the Public Sub declaring the 2nd module and added a Next in there. It is functioning almost like I want it, but hey at least I have it combined the way I need it!
 
Joined
Jul 25, 2004
Messages
5,458
Thanks for posting what you did to solve the problem! If there's something else we can help you with, don't hesitate to ask. :)
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Top