VBA Code to Run Other VBA Codes in Multiple Workbooks

[bopha99]

Hello,

From the help of offthelip, I've got a VBA code that works on multiple worksheets in a single workbook. What would be great addition would be another VBA code that would be able to refresh and reset each worksheet in each workbook and then run each VBA code in each workbook automatically so that I would not have to open each Excel spreadsheet and manually run the VBA code.

What I'm trying to create with a refresh and reset each worksheet function is basically a VBA function that will restore the original formula that was once in the cell prior to the VBA code "hard coding" something over it. I would like to basically create a template and have the cash flow models feed off this template so that I could run the VBA code from it from a clean worksheet that has not been hard coded by the VBA code.

Essentially what I'm saying is that if I were to have 10 sheets or more of this cash flow and the VBA code, if I were to run the VBA code once, it would hard code correctly like it should, but then I would not be able to re-use these 10 sheets for another cash flow scenario. This can be a problem if I were to have 50 workbooks that were all feeding from a single template. Does this make sense?

I am trying to create a group of workbooks where the VBA code can be reused after it has run once based on a different cash flow scenario. See the attached excel file and the VBA code with it. In the excel file, income rows 3-6 and rows 13-19 feed off rows 79-82 and rows 84-90. If I were to run the VBA code, it would hardcode over this feed correctly, but then I would not be able to re-use the sheet over because of the hard coding. Is there a way to reverse the VBA code to get the original sheet back?

Thanks in advance for your help.

[mdmackillop]

Something like this (untested) will cycle though books and sheets, creating a dated copy of each workbook and preserving the original.

Sub LooopBookAndSheets()
Dim wb as Workbook    
Dim ws As Worksheet
Dim wbArr, bk
Dim Ext as String
Dim pth as string

  pth = "C:\Test\"  'Change to suit
     wbArr = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & pth & "*.xl*" & """ /b /a-d").stdout.readall, vbCrLf), ".") 
    For Each bk In wbArr 
        Set wb = Workbooks.Open(pth & bk) 
        For Each ws In wb.Worksheets 
            Call balance(ws) 
        Next ws 
         'Make a copy, close without saving
        Ext = Right(wb.Name, 5) 
        wb.SaveCopyAs pth & Replace(wb.Name, Ext, "") & Format(Date, "_yy_mm_dd") & Ext 
        wb.Close False 
    Next bk 
End Sub
    
Sub balance(ws As Worksheet)
    With ws
     ' do all the years
    For i = 2 To 11
         ' loop through all the accounts
        For ii = 1 To 11
            inarr = Range(.Cells(1, 1), .Cells(57, 11))
            If inarr(45, i) < 0 Then
                 ' we need to balance
                 ' find largest account
                maxb = 0
                maxro = 0
                For j = 45 To 56
                    If inarr(j, i) > maxb Then
                        maxb = inarr(j, i)
                        maxro = j
                    End If
                Next j
                If maxb > 0 Then
                    If maxro < 50 Then
                         'not taxable so dived by .7
                        balamount = (10000 - inarr(45, i)) / 0.6
                        accro = maxro - 43
                    Else
                        balamount = (10000 - inarr(45, i))
                        accro = maxro - 37
                    End If
                    If balamount > maxb Then
                        .Cells(accro, i) = maxb
                    Else
                        .Cells(accro, i) = balamount
                    End If
                End If
            End If
        Next ii
    Next i
    End With
End Sub

[bopha99]

MD,

I have 3 workbooks with the VBA code in the same folder. When I run your code, I get Runtime error '9', subscript out of range. I'm not sure what this means, but will the code try to go through all the files in the folder and re-save each file? Thanks in advance.

[mdmackillop]

I get Runtime error '9', subscript out of range

You need to tell us what line creates the error

[bopha99]

You need to tell us what line creates the error

MD,

When I run the macro, a window pops up and says macro name: This Workbook.LooopBookAndSheets ....then i click run and it says Subscript out of range. How can I tell which line is giving the error?

[mdmackillop]

You step through the code in the VBE window using the F8 key. There is a useful debugging tutorial here

[Simon Lloyd]

MD,
When I run your code, I get Runtime error '9', subscript out of range. I'm not sure what this means, ........

Runtime Error 9 normally denotes that the workbook or worksheet you are calling doesn't exist, it could be a typo or it could have trailing or leading spaces, post the code EXACTLY as you have it now in your workbook along with a notation of which line it shows in yellow when the code bugs out.

[bopha99]

Thanks Simon and MD,

The code is:

Sub LooopBookAndSheets()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wbArr, bk
    Dim Ext As String
Dim Pth as String
     
    pth = "C:\Test\"   'Change to suit
wbArr = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & pth & "*.xl*" & """ /b /a-d").stdout.readall, vbCrLf), ".")
For Each bk In wbArr
Set wb = Workbooks.Open(pth & bk)
For Each ws In wb.Worksheets
Call balance(ws)
Next ws
'Make a copy, close without saving
Ext = Right(wb.Name, 5)
wb.SaveCopyAs pth & Replace(wb.Name, Ext, "") & Format(Date, "_yy_mm_dd") & Ext
wb.Close False
Next bk


End Sub
 
Sub balance(ws As Worksheet)
    With ws
         ' do all the years
        For i = 2 To 11
             ' loop through all the accounts
            For ii = 1 To 11
                inarr = Range(.Cells(1, 1), .Cells(57, 11))
                If inarr(45, i) < 0 Then
                     ' we need to balance
                     ' find largest account
                    maxb = 0
                    maxro = 0
                    For j = 45 To 56
                        If inarr(j, i) > maxb Then
                            maxb = inarr(j, i)
                            maxro = j
                        End If
                    Next j
                    If maxb > 0 Then
                        If maxro < 50 Then
                             'not taxable so dived by .7
                            balamount = (10000 - inarr(45, i)) / 0.6
                            accro = maxro - 43
                        Else
                            balamount = (10000 - inarr(45, i))
                            accro = maxro - 37
                        End If
                        If balamount > maxb Then
                            .Cells(accro, i) = maxb
                        Else
                            .Cells(accro, i) = balamount
                        End If
                    End If
                End If
            Next ii
        Next i
    End With
End Sub

and it highlights wbArr = Sheets("Books").Range("A1:A10") 'or loop through folder or whatever

so I'm thinking it has something to do with "Books"? How do I make it go through all the workbooks in the folder "Test"

[mdmackillop]

It never occured to me you would not change that line to suit your own arrangement. I've amended your code above to refer to files in C:\Test\. Please change this to suit.