Loop through folder

[Blackwater]

Hello,
I have two macros in my PERSONAL.xlsb, that does some formating and stuff to opened .csv file and autoclose it to certain location. However, since i started to operate with multiple files so i would like to ask if someone has some macro that does

1.) open file
2.) run macro (which in my case autosaves and close the file)
3.) proceed to open another file

--- and so on until all files has been processed ---


I have been searching here for the code, but none of the macros really worked, either, after runing the macro nothing happens, or it throw some error on me

I believe its really specific since i have it in personal.xlsb not a custom macro file..

If there is a solution or someone has some script that would help me and will post it here.. Thank you very much

 

[Blackwater]

Unfortunately, i have to report it doesnt work like, the macro to loop files works, but the original macro i recorded doesnt..

This is my full macro to loop and edit files

Sub LoopThroughFolder()

    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Set Wb = ThisWorkbook
    MyDir = "D:\CUBA\FA\"
    MyFile = Dir(MyDir & "*.csv")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""

    Workbooks.Open MyDir & MyFile
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A13:I13").Select
    Range("I13").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("E:E,G:G,H:H").Select
    Range("H1").Activate
    Selection.NumberFormat = "0.00"
    Range("G13,E13").Select
    Range("E13").Activate
    Selection.NumberFormat = "m/d/yyyy"
    Range("G26").Select
    Range("A13:I13").Select
    Range("I13").Activate
    Selection.Font.Bold = True
    Range("C12").Select
            Dim lastRow As Long
lastRow = Range("A5000").End(xlUp).Row
Range("A" & lastRow + 1) = "Sumár"
Range("E" & lastRow + 1).Formula = "=SUM(E16:E" & lastRow & ")"
Range("G" & lastRow + 1).Formula = "=SUM(G16:G" & lastRow & ")"
Range("H" & lastRow + 1).Formula = "=SUM(H16:H" & lastRow & ")"
Dim lr As Long, r As Long
lr = ActiveSheet.UsedRange.Rows.Count
Range("A" & lr & ":H" & lr).Interior.ColorIndex = 35
    Dim xlBook
    Set xlBook = ActiveWorkbook

    ChDir "D:\01 SMT OUT\"
    ActiveWorkbook.SaveAs Filename:= _
                          "D:\01 SMT OUT\" & Left(xlBook.Name, (InStrRev(xlBook.Name, ".", -1, vbTextCompare) - 1)) & ".xlsx", FileFormat:= _
                          xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=True
        MyFile = Dir()
    Loop

End Sub

and this is the macro i use to edit files which works separately but doesnt within the loop macro

Sub MakroFA()
'
' Makro1 Makro
'
' Klávesová skratka: Ctrl+Shift+S
'
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A13:I13").Select
    Range("I13").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("E:E,G:G,H:H").Select
    Range("H1").Activate
    Selection.NumberFormat = "0.00"
    Range("G13,E13").Select
    Range("E13").Activate
    Selection.NumberFormat = "m/d/yyyy"
    Range("G26").Select
    Range("A13:I13").Select
    Range("I13").Activate
    Selection.Font.Bold = True
    Range("C12").Select
            Dim lastRow As Long
lastRow = Range("A5000").End(xlUp).Row
Range("A" & lastRow + 1) = "Sumár"
Range("E" & lastRow + 1).Formula = "=SUM(E16:E" & lastRow & ")"
Range("G" & lastRow + 1).Formula = "=SUM(G16:G" & lastRow & ")"
Range("H" & lastRow + 1).Formula = "=SUM(H16:H" & lastRow & ")"
Dim lr As Long, r As Long
lr = ActiveSheet.UsedRange.Rows.Count
Range("A" & lr & ":H" & lr).Interior.ColorIndex = 35
    Dim xlBook
    Set xlBook = ActiveWorkbook

    ChDir "D:\01 SMT OUT\"
    ActiveWorkbook.SaveAs filename:= _
                          "D:\01 SMT OUT\" & Left(xlBook.Name, (InStrRev(xlBook.Name, ".", -1, vbTextCompare) - 1)) & ".xlsx", FileFormat:= _
                          xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=True
End Sub

i tried to edit it a lot, changed dims etc but nothing worked so far :/

 

[davesexcel]

Can you explain how it doesn't work?
What is the error messages you are getting?
What line does the code fail?

 

[davesexcel]

Can you work with this...

Sub LoopThroughFolder()

    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    '----------------
    Dim lastRow As Long
    Dim lr As Long, r As Long
    Dim xlBook, sh As Worksheet
    '-------------------
    Set Wb = ThisWorkbook



    'change the address to suite
    MyDir = "C:\Users\dmorrison\Downloads\TestLoopFolder\"
    MyFile = Dir(MyDir & "*.xls")    'change file extension
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        '--------------------------------------
        Set xlBook = ActiveWorkbook
        Set sh = xlBook.Sheets(1)
        With sh
            With .Range("A13:I13").Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.399975585192419
                .PatternTintAndShade = 0
            End With
            .Range("E:E,G:G,H:H").NumberFormat = "0.00"
            .Range("G13,E13").NumberFormat = "m/d/yyyy"
            .Range("A13:I13").Font.Bold = True
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("A" & lastRow + 1) = "Sumár"
            .Range("E" & lastRow + 1).Formula = "=SUM(E16:E" & lastRow & ")"
            .Range("G" & lastRow + 1).Formula = "=SUM(G16:G" & lastRow & ")"
            .Range("H" & lastRow + 1).Formula = "=SUM(H16:H" & lastRow & ")"
            lr = .UsedRange.Rows.Count
            .Range("A" & lr & ":H" & lr).Interior.ColorIndex = 35
            .Cells.EntireColumn.AutoFit
        End With
        '---------------------------------------

        With xlBook
            .Save
            .Close
        End With
        MyFile = Dir()
    Loop

End Sub

 

[Blackwater]

Thanks,
i tried it with your code, but it doesnt work, it does the same as mine does, mine works just fine without the loop, i tested it, but when i add the macro that cause to loop files its broken. Almost everything is in A cell and the coding is broken..

 

[davesexcel]

Refer to post #12