VBA loop Help

[Legacy 93538]

Hi

I have this piece of code which loops through one folder and opens each csv file within it and performs a counta and pastes the results into a sepeate document which then is saved and closed.
<!-- BEGIN TEMPLATE: bbcode_code -->

<STYLE>.alt2 font {font: 11px monospace !important;color: #333 !important;}</STYLE>

Sub Get_Average_Count()
'********************************************************************
'Opens the extract size checker document
'Loops through the Averagedata folder
'Takes a count of all files in the folder
'Places the result into the extract size checker document
'JS - 17/01/2011
'********************************************************************
'Define Variables
    'Const strFldr As String = "Path3"
    Dim strFldr As String
    Dim strFile As String
    Dim wbExtractSize As Workbook
    Dim wbCsv As Workbook
    Dim wsAverageExtracts As Worksheet
    Dim wsMyCsvSheet As Worksheet
    Dim lNextRow As Long
'set strFldr variables
    strFldr = Path3
'set strFile variables
    strFile = Dir(strFldr & "\*.csv")
'set the calculation mode
    Application.Calculation = xlCalculationManual
'set the workbook and worksheet
    Set wbExtractSize = ActiveWorkbook
    Set wsAverageExtracts = wbExtractSize.Sheets("Average Extracts")
'find the next row available in ExtractSize, add two to
    lNextRow = 18
'Loop through the csv files
    If Len(strFile) > 0 Then
        Do
            Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile)
            Set wsMyCsvSheet = wbCsv.Sheets(1)
            With wsAverageExtracts
                .Cells(lNextRow, 6) = strFldr
                .Cells(lNextRow, 7) = strFile
                .Cells(lNextRow, 8) = WorksheetFunction.CountA(wsMyCsvSheet.Range("A:A"))
            End With
        
        'increment to the next row
            lNextRow = lNextRow + 1
        
        'close it
            wbCsv.Close
        
        'go to next file
            strFile = Dir
            Application.StatusBar = strFile
        Loop Until Len(strFile) = 0
    End If
     
'Close and Save document
    ActiveWorkbook.ActiveSheet.Range("A1").Select
    ActiveWorkbook.SaveAs Filename:=Path14 & "Extract_Size_Checker_" & bMthno & "_" & bYear & ".xls)"
    ActiveWorkbook.Close
'clean up
    Set wbExtractSize = Nothing
    Set wbCsv = Nothing
    Set wsAverageExtracts = Nothing
    Set wsMyCsvSheet = Nothing
End Sub

</PRE><!-- END TEMPLATE: bbcode_code -->However i now must change this piece of code so it opens a folder and performs a count on all the files within each of sub folders that are in this folder. However i am stumped and i have no idea how to do thsi. Can anyone help me???


Thanks
Jessicaseymour

 

[al_b_cnu]

Hi,

Maybe you can adapt the code example here: http://www.dailydoseofexcel.com/arc...hing-files-in-subfolders-for-vba-code-string/

 

[Legacy 93538]

Hi

Thank you replying.

I had a look but i am not sure i understood the code. I was wondering if there was a way to wrap another loop around the current loop to open each sub folder and then perform the forumla loop.

Thank you

jeskit

 

[al_b_cnu]

Hi,
the version of Get_Average_Count in this example just displays the file name:

Option Explicit

Sub XXX()
Dim iFilePtr As Integer
Dim strFile As String
Const sFileFilter As String = "*.xls"
Dim sFolder As String

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = ThisWorkbook.Path
    .Show
    If .SelectedItems.Count = 0 Then
        MsgBox "Macro Abandoned"
        Exit Sub
    End If
    sFolder = .SelectedItems(1)
End With

With Application.FileSearch
        .NewSearch
        .LookIn = sFolder
        .Filename = sFileFilter
        .SearchSubFolders = True
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
 
        If .Execute() > 0 Then
            For iFilePtr = 1 To .FoundFiles.Count
                strFile = .FoundFiles(iFilePtr)
                Get_Average_Count strFile
            Next iFilePtr
        End If
End With
End Sub

Sub Get_Average_Count(ByVal strFile As String)
MsgBox strFile
End Sub

 

[Legacy 93538]

Thanks for your help but i have a solution now! Thanks