Excel/VisualBasic: Turning daily textfiles into monthly spreadsheets

The task was to use text files that are created by an external program on a daily basis to create a workbook that contains those files’ data in monthly spreadsheets. The good thing is, the text files were named ‘DATAYYMMDD’, so there is a keyword (“DATA”) and the actual date in year, month and day form.

Let’s go! To create a new macro you simply select ‘Tools’→’Macro’→’Macros’ or hit Alt+F8 to get the list of macros that acually exist. By typing in a macro name (“myMacroName” for now), the ‘Create’ option becomes available. Hit it. Now we are presented with something like

Sub myMacroName()

End Sub

Now that’s clean. To see what parameters a function needs I often use ‘Tools’→’Macro’→’Record new Macro’. When done I have a look at the automatically created code and adjust it the way I need it. I would strongly recommend that to find what parameters the import function will need.

Alright, first thing that we do, is creating a string of a given date. I need three count variables that hold the actual numbers and thus can do some math. While turning them into strings I check if they comply with the YYMMDD format. So, if a number is less than 10 I add add “0” to the string to get strings like “090909” instead of “999” for September 9, 2009. This string is presented in actualDate.

Sub myMacroName()

yearCount = 9
monthCount = 1
dayCount = 1

If yearCount <= 9 Then
    yearString = "0" & yearCount
Else
    yearString = yearCount
End If

If monthCount <= 9 Then
    monthString = "0" & monthCount
Else
    monthString = monthCount
End If

If dayCount <= 9 Then
    dayString = "0" & dayCount
Else
    dayString = dayCount
End If

actualDate = yearString & monthString & dayString

End Sub

Ok, so far so good. To transfer that data we need a new sheet in our workbook. That is easily created and with our strings the name is set fast. And we need an end date so the macro won't loop forever.

Sheets.Add
ActiveSheet.Name = yearString & monthString

endDate = "100428"

Next thing to do is setting up the loop. We'll go with a simple While Wend here just by checking if actualDate is not equal to our endDate

While actualDate <> endDate

pathName = "C:\complete\path\here\to\datafolder\"
fileNameString = "DATA" & yearString & monthString & dayString & ".TXT"
nameString = "DATA" & yearString & monthString & dayString
compString = pathName & fileNameString

In pathName the complete folder structure is given to access the text files. It is included in the loop here though it is not neccessary but maybe you have got data that is already in folders that are created with the date. fileNameString is the complete file name. So, for September 9, 2009 we would get "DATA090909.TXT". Don't forget the extension. nameString is the file name without extension and thus the name of the spreadsheet that the imported text file will create. compString is the complete path including the file name. We will need that to open the file. We'll do that now and we'll do it straightforward.

If Len(Dir(compString)) > 0 Then
    Workbooks.OpenText Filename:=compString _
    , Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
    Array(Array(0, 1), Array(5, 1), Array(17, 1), Array(26, 2), Array(41, 1), Array(45, 1), _
    Array(53, 1), Array(132, 1)), TrailingMinusNumbers:=True
    Windows(fileNameString).Activate
    Sheets(nameString).Select
    Sheets(nameString).Move After:=Workbooks("myWorkBook.xls").Sheets(1)
    Range("A2").Select
    If ActiveCell.Value <> "" Then
    Range("A1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Cut
        Sheets(yearString & monthString).Select
        ActiveSheet.Paste
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
    End If
    Sheets(nameString).Select
    ActiveWindow.SelectedSheets.Delete
End If

Woof! Ok, the first line checks if there is a file with that name in that path. Cool, eh? With OpenText the text file is imported (surprise!) and that is done involving all the parameters I told you to get experimentally before. That sheet is then moved to the workbook ("myWorkBook.xls"). Then I check if there is a value on the second row. Not the best choice if there were days with only one entry but you can fit that to your needs. If the second cell has a value, the whole area containing values is cut and transferred to the relevant monthly spreadsheet. Afterwards, the imported daily sheet is deleted. One addition on this: In order to get around confirming every deletion we set Application.DisplayAlerts = False on the first line of that macro and True on the last line.

That's nearly it. Now we need the next day, if it is the last of the month it's day one of the next month and after some turns we will need to set it day one of month one of the next year. Every time a new month begins a new sheet needs to be created, so a little boolean will tell the macro when and when not.
While setting the new values these are transformed into strings like in the beginning of the macro. Oh, and the actual date is created from the new strings before finishing the loop with Wend.

dayCount = dayCount + 1
newSheetBool = False
If dayCount > 31 Then
    dayCount = 1
    monthCount = monthCount + 1
    newSheetBool = True
    If monthCount > 12 Then
        monthCount = 1
        yearCount = yearCount + 1
        newSheetBool = True
    End If
End If

If dayCount <= 9 Then
    dayString = "0" & dayCount
Else
    dayString = dayCount
End If

If monthCount <= 9 Then
    monthString = "0" & monthCount
Else
    monthString = monthCount
End If

If yearCount <= 9 Then
    yearString = "0" & yearCount
Else
    yearString = yearCount
End If

If newSheetBool = True Then
    Sheets.Add
    ActiveSheet.Name = yearString & monthString
End If

actualDate = yearString & monthString & dayString

Wend

Fantastic. The box below holds the complete code. Leave a comment if that helped in any way.

Sub gather()

Application.DisplayAlerts = False

Range("A1").Select

yearCount = 9
monthCount = 1
dayCount = 1

If yearCount <= 9 Then
    yearString = "0" & yearCount
Else
    yearString = yearCount
End If

If monthCount <= 9 Then
    monthString = "0" & monthCount
Else
    monthString = monthCount
End If

If dayCount <= 9 Then
    dayString = "0" & dayCount
Else
    dayString = dayCount
End If

Sheets.Add
ActiveSheet.Name = yearString & monthString

endDate = "100428"

actualDate = yearString & monthString & dayString

While actualDate <> endDate

pathName = "C:\complete\path\here\to\datafolder\"
fileNameString = "DATA" & yearString & monthString & dayString & ".TXT"
nameString = "DATA" & yearString & monthString & dayString
compString = pathName & fileNameString

If Len(Dir(compString)) > 0 Then
    existsString = "exists"
    Workbooks.OpenText Filename:=compString _
    , Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
    Array(Array(0, 1), Array(5, 1), Array(17, 1), Array(26, 2), Array(41, 1), Array(45, 1), _
    Array(53, 1), Array(132, 1)), TrailingMinusNumbers:=True
    Windows(fileNameString).Activate
    Sheets(nameString).Select
    Sheets(nameString).Move After:=Workbooks("design.xls").Sheets(1)
    Range("A2").Select
'    If ActiveCell.Value = "" Then
'        ActiveCell.Value = "empty" & monthString & "0" & dayString
'        ActiveCell.Offset(1, 0).Select
'        ActiveCell.Value = "empty" & monthString & "0" & dayString
'        Range("A1").Select
'    End If
    If ActiveCell.Value <> "" Then
    Range("A1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Cut
        Sheets(yearString & monthString).Select
        ActiveSheet.Paste
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
    End If
    Sheets(nameString).Select
    ActiveWindow.SelectedSheets.Delete
Else
    existsString = "no file"
End If

dayCount = dayCount + 1
newSheetBool = False
If dayCount > 31 Then
    dayCount = 1
    monthCount = monthCount + 1
    newSheetBool = True
    If monthCount > 12 Then
        monthCount = 1
        yearCount = yearCount + 1
        newSheetBool = True
    End If
End If

If dayCount <= 9 Then
    dayString = "0" & dayCount
Else
    dayString = dayCount
End If

If monthCount <= 9 Then
    monthString = "0" & monthCount
Else
    monthString = monthCount
End If

If yearCount <= 9 Then
    yearString = "0" & yearCount
Else
    yearString = yearCount
End If

If newSheetBool = True Then
    Sheets.Add
    ActiveSheet.Name = yearString & monthString
End If

actualDate = yearString & monthString & dayString

Wend

Application.DisplayAlerts = True

End Sub

In ur macros, pillaging ur variabls. Yoho!

This entry was posted in Excel, MS Office and tagged , , , , . Bookmark the permalink.
Be Sociable, Share!

Leave a Reply

Your email address will not be published.