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!