Loop code to run macro multiple times

Question

I have this vba macro that extracts data from a text file and puts it into a column in Excel. The files are named by days (2016mmdd). Currently, I run this macro for each day. Now I want it such that when this Macro is run, the data for all the days in the declared month (say August) will be automatically extracted into different columns (a column per each day of the month). So that I won't have to manually run it 31 times if there are 31 days in the month. Thanks for helping.

Sub Macro7()
'
' Macro7 Macro
'
' Keyboard Shortcut: Ctrl+x
'

Dim fileDate, rng, rng1, rng2, rng3, rcell As String

 b = InputBox("Enter file Name mmdd", "File name")
 rcell = InputBox("Enter cell reference", "Reference name")

 rng = "$" & rcell & "$2"
 rng1 = rcell & "2:" & rcell & "14"
 rng2 = rcell & "52:" & rcell & "62"
 rng3 = rcell & "2:" & rcell & "101"

 Filename = "j:\files\2016" & b & "2259.txt"

     With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;j:\files2016" & b & "2259.txt", Destination:= _
        Range(rng))

        .Name = "tr" & b
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 1, 9)
        .TextFileFixedColumnWidths = Array(103, 4)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    Range(rng1).Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=45
    Range(rng2).Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-60
    Range(rng3).Select
End Sub

Answer 1

The quick approach would be to re-write Sub Macro7() to accept parameters, e.g.

Sub ImportFiles(FName As String, ColNum As Integer)

    ' blablabla

    ' work with range objects ... not with patched strings containing range addresses
    Dim Rng As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range

    Set Rng = Cells(2, ColNum)
    Set Rng1 = Range(Cells(2, ColNum), Cells(14, ColNum))
    Set Rng2 = Range(Cells(52, ColNum), Cells(62, ColNum))
    Set Rng3 = Range(Cells(2, ColNum), Cells(101, ColNum))

    Filename = "j:\files\2016" & FName & "2259.txt"

    ' and replace <Destination := Range(Rng)> by <Destination := Rng>

    ' blablabla

    ' use the range objects defined/set earlier ... save on Select/Selection
    Rng1.Delete xlUp
    Rng2.Delete xlUp
    Rng3.Select


End Sub

and have a calling Macro e.g.

Sub DoWorklist()

    ImportFiles "0901", 1
    ImportFiles "0902", 2
    ImportFiles "0903", 3
    ' blablabla

    'alternative

    Dim Idx As Integer

    For Idx = 1 To 30
         ' to overcome well spotted chr() issue we convert running number Idx
         ' into 2 digit string with leading "0"
        ImportFiles "09" & Format(Idx, "00"), Idx
    Next Idx


End Sub