How to prepare fixed format file from excel using vba [duplicate] - vba

Question

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 7 years ago.
Improve this question
This picture is my excel data format, I wanna export it into text file with fixed column width, example:
User ID Total Work
001 22:00 17:00
002 4:00 4:00
How to set PERSONAL.XLSB auto run my script when always open a newly created specific name workbook?
I tried to add this script into XLSB > ThisWorkBook
Private WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Application.Run ("PERSONAL.XLSB!TASUBSPayroll")
End Sub
After open the specific name workbook, it was exported a text file without export the data out:
User ID Total Work
I think it was run the macro on PERSONAL.XLSB only and not run to my specific name workbook.
http://i.imgur.com/EETLL6V.jpg
I was add the these code into the module name as "TASUBSMacro" in VBAProject(PERSONAL.XLSB) but it still not run the macro for the TotalTimeCardReport.xlsx.
Private Sub Workbook_Open()
Run "MyMacro"
End Sub
This TotalTimeCardReport.xlsx was exported from some software and auto open it with excel. But I was combined with the PERSONAL.XLSB and it was still not run the macro - module from PERSONAL.XLSB to TotalTimeCardReport.xlsx.

Answer 1

Loop all rows and all cells. Send each value to a padspace function. Build the string from for each cells value with spaces padded after the cell value.
You will have to add a reference to you workbook. In the VBA IDE go to the tools pull down menu and select references. Then scroll down and select "Microsoft Scripting Runtime". Then hit OK.
Adjust the pad space function call argument to a number that fits the data that you have in your spreadsheet. So you will change the 20 in the line with the padspace call. PadSpace(20, len(cellValue))
This will do all rows and columns.
Public Sub MyMacro()
Dim lRow As Long
Dim lCol As Long
Dim strRow As String
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject
'Create the text file to write to
Set fs = New FileSystemObject
Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False)
Set ws = Application.ActiveSheet
'Loop through all the rows.
lRow = 1
Do While lRow <= ws.UsedRange.Rows.count
'Clear the string we are building
strRow = ""
'Loop through all the columns for the current row.
lCol = 1
Do While lCol <= ws.UsedRange.Columns.count
'Build a string to write out.
strRow = strRow & ws.Cells(lRow, lCol) & PadSpace(20, Len(ws.Cells(lRow, lCol)))
lCol = lCol + 1
Loop
'Write the line to the text file
ts.WriteLine strRow
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
ts.Close: Set ts = Nothing
Set fs = Nothing
End Sub
'This function will take the max number of spaces you want and the length of the string in the cell and return you the string of spaces to pad.
Public Function PadSpace(nMaxSpace As Integer, nNumSpace As Integer) As String
If nMaxSpace < nNumSpace Then
PadSpace = ""
Else
PadSpace = Space(nMaxSpace - nNumSpace)
End If
End Function
If you only want to target certain rows and columns you can test for values as you loop. And then target columns. Something like this.
Public Sub MyMacro()
Dim lRow As Long
Dim lCol As Long
Dim strRow As String
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject
'Create the text file to write to
Set fs = New FileSystemObject
Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False)
Set ws = Application.ActiveSheet
'Write the header row
strRow = "User ID" & PadSpace(20, Len("User ID"))
strRow = strRow & "Total" & PadSpace(20, Len("Total"))
strRow = strRow & "Work" & PadSpace(20, Len("Work"))
ts.WriteLine strRow
'Loop through all the rows.
lRow = 1
Do While lRow <= ws.UsedRange.Rows.Count
'Clear the string we are building
strRow = ""
If ws.Range("A" & lRow).Value = "User ID" Then
'Build the string to export
strRow = ws.Range("B" & lRow).Value & PadSpace(20, Len(ws.Range("B" & lRow).Value))
strRow = strRow & ws.Range("F" & lRow + 2).Value & PadSpace(20, Len(ws.Range("F" & lRow + 2).Value))
strRow = strRow & ws.Range("F" & lRow + 3).Value & PadSpace(20, Len(ws.Range("F" & lRow + 3).Value))
'Write the line to the text file
ts.WriteLine strRow
End If
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
ts.Close: Set ts = Nothing
Set fs = Nothing
End Sub
Public Function PadSpace(nMaxSpace As Integer, nNumSpace As Integer) As String
If nMaxSpace < nNumSpace Then
PadSpace = ""
Else
PadSpace = Space(nMaxSpace - nNumSpace)
End If
End Function
Response to user question. To run a macro on workbook open.
Private Sub Workbook_Open()
Run "MyMacro"
End Sub
"MyMacro" is the name of the procedure in a public module Insert -> Module.
If you want to run code from a private module you cannot use "Run" command just use the procedure name.
Private Sub Workbook_Open()
MyMacro
End Sub