Loop through all Workbooks and all Worksheets, format and copy to template

2
votes

I have a template workbook that I want to run this code from. The code is to loop through all the files in a directory, and loop through all the worksheets in each file. Within each worksheet, run a process that basically format the data, then copy paste to a worksheet within the template workbook where more formatting is done.

This code that I have works when there is only one worksheet in the file, but when there are more than one, the worksheet loop occurs on the template workbook instead of the files.

I've created the formatting code as a different macro to be Call upon. I've tried adding the worksheet loop within the formatting macro, but get the same issue.

Option Explicit Sub testLoopTabs()

Dim MyFolder As String, MyFile As String
Dim wb As Workbook, wbCopy As Workbook
Dim ws As Worksheet 'to loop through all the sheets

'Opens a file dialog box for user to select a folder

With Application.FileDialog(msoFileDialogFolderPicker)
   .AllowMultiSelect = False
   .Show
   MyFolder = .SelectedItems(1)
   Err.Clear
End With

'stops screen updating, calculations, events, and statsu bar updates to help code run faster
'you'll be opening and closing many files so this will prevent your screen from displaying that
MemorySave True 'You can use this procedure instead

'This section will loop through and open each file in the folder you selected
'and then close that file before opening the next file

MyFile = Dir(MyFolder & "\", vbReadOnly)
Set wb = ThisWorkbook 'to refer to the workbook containing the code

Do While MyFile <> ""
    Set wbCopy = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False, ReadOnly:=True)
    'loop worksheet
     ' Begin the loop.
    For Each ws In wbCopy.Worksheets

'run process

'format data
Rows("1:14").Select
Selection.Delete Shift:=xlUp

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.WindowState = xlMaximized
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Selection.UnMerge
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Market"
Range("A2").Select

ActiveCell.FormulaR1C1 = _
    "=MID(CELL(""filename"",R[-1]C),FIND(""]"",CELL(""filename"",R[-1]C))+1,255)"
Range("A2").Select
Selection.Copy

    With Range("B1")
Range(.Cells(2, 0), .End(xlDown).Offset(0, -1)).Select

End With

ActiveSheet.Paste



'format dates and text to column
Columns("E:F").Select
Application.CutCopyMode = False
Selection.NumberFormat = "dd/mm/yyyy"
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


'find Net Value column
Dim cell As Range
Dim I As Integer
For I = 12 To 20

    If Cells(1, I).Value = "Net Amount" Then
    Columns(I).Select
    Selection.Cut
    Columns("K:K").Insert Shift:=xlToRight


    Else

    End If

Next I


'format numbers to general
Columns("H:H").Select
Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


 Columns("K:K").Select
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Columns("M:M").Select
Selection.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True



'add Other Charges

Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "Other Charges"
Range("N2").Select
Application.CutCopyMode = False


    ActiveCell.FormulaR1C1 = _
    "=IF(RC[-7]=""B"",ROUND(RC[-3]-RC[-2]-RC[-1],2),ROUND(RC[-2]-RC[-3]-RC[-1],2))"

Range("N2").Select


If IsEmpty(Range("B3")) = False Then

    Range("N2").Select
    Selection.Copy

With Range("M2")
Range(.Cells(2, 2), .End(xlDown).Offset(0, 1)).Select

End With

    ActiveSheet.Paste

Range("A2:N2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

Else

Range("A2:N2").Copy

End If



'paste to brokertradefile

wb.Worksheets("BrokerTradeFile").Activate

Range("A6").End(xlDown).Offset(1, 0).Select

ActiveSheet.Paste
Application.CutCopyMode = False

'end process

wbCopy.Activate

        ' The following line shows how to reference a sheet within
        ' the loop by displaying the worksheet name in a dialog box.
        MsgBox ws.Name
    Next ws
    MsgBox wbCopy.Name
    wbCopy.Close SaveChanges:=False
    MyFile = Dir
Loop

'turns settings back on that you turned off before looping folders
MemorySave False

End Sub Sub MemorySave(isOn As Boolean)

Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
Application.EnableEvents = Not (isOn)
Application.ScreenUpdating = Not (isOn)
Application.DisplayStatusBar = Not (isOn)
ActiveSheet.DisplayPageBreaks = False

End Sub

1
excelvba
Instead of relying on ActiveWorkbook, use a workbook variable. Dim wb as Workbook, then Set wb = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False). This gives you a reference to the workbook to then use. – BigBen
I've amended the code to include the Dim wb as Workbook and Set wb as commented about. I then replaced all the ActiveWorkbook with with wb. However it still doesn't work. On the files that contains more than one worksheet, it just loops back to the first worksheet. – Temujin81
@Temujin81 can you update your code on your post? So we can help you further. – Damian
Agreed, can you share the formattradefiledata code? – BigBen

1 Answers

0
votes

Here is how I would do this:

Option Explicit
Sub testLoopTabs()

    Dim MyFolder As String, MyFile As String
    Dim wb As Workbook, wbCopy As Workbook
    Dim ws As Worksheet 'to loop through all the sheets

    'Opens a file dialog box for user to select a folder

    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       MyFolder = .SelectedItems(1)
       Err.Clear
    End With

    'stops screen updating, calculations, events, and statsu bar updates to help code run faster
    'you'll be opening and closing many files so this will prevent your screen from displaying that
    MemorySave True 'You can use this procedure instead

    'This section will loop through and open each file in the folder you selected
    'and then close that file before opening the next file

    MyFile = Dir(MyFolder & "\", vbReadOnly)
    Set wb = ThisWorkbook 'to refer to the workbook containing the code

    Do While MyFile <> ""
        Set wbCopy = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False, ReadOnly:=True)
        'loop worksheet
         ' Begin the loop.
        For Each ws In wbCopy.Worksheets
            'run process
            Call formattradefiledata
            'end process

            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
            MsgBox ws.Name
        Next ws
        MsgBox wbCopy.Name
        wbCopy.Close SaveChanges:=False
        MyFile = Dir
    Loop

    'turns settings back on that you turned off before looping folders
    MemorySave False

End Sub
Sub MemorySave(isOn As Boolean)

    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    Application.DisplayStatusBar = Not (isOn)
    ActiveSheet.DisplayPageBreaks = False

End Sub

Note that I added another procedure for your memory managing(you only need to call the procedure with True to activate the memory saving options and call it back with false to turn everything back on).

When you reference workbooks and worksheets nothing can go wrong. In my code the workbook with the code is referenced as wb, the files which are being open are referenced as wbCopy and to loop through all the worksheets you can use For Each ws In wbCopy.Worksheets after you reference ws As Worksheet. Is like telling excel, for every worksheet in the sheets from the workbook wbCopy.