Save as text file in a certain format similar to an xml

[PippaThePointer]

Hi,
Hoping for some simple advice as my brain is cooked today.
I have a data sheet that contains column A 'Size' and then Column B,C,D contain text.
I would like to run a vba to save the data as a text file, but i need it in a certain way.

The resulting text file ideally would be one file but the data grouped into <begindoc> <enddoc> from B,C,D and ideally also grouped by same data in Column A (Size). This one text file would then be saved to a certain location with .mergefile as the extention

Size	First	Second	Third
Size1	duplicate=2,FileA.pdf	duplicate=0,FileA.pdf	duplicate=2,FileA.pdf
Size1	duplicate=0,FileB.pdf	duplicate=0,FileB.pdf	duplicate=1,FileB.pdf
Size2	duplicate=2,FileC.pdf	duplicate=2,FileC.pdf	duplicate=2,FileC.pdf
Size2	duplicate=2,FileD.pdf	duplicate=2,FileD.pdf	duplicate=2,FileD.pdf
Size2	duplicate=2,FileE.pdf	duplicate=2,FileE.pdf	duplicate=2,FileE.pdf

inputfolder=C:\testfileinputlocation
outputfolder=C:\testfileoutputlocation
reportfile=C:\testlogfilelocation\ProcessingLog.htm
overwrite=no
padtoeven=no
author=Me
title=filename
// First output document is data from column N for each size in column C
<begindoc>
duplicate=2,FileA.pdf
duplicate=0,FileB.pdf
document=First-Size1.pdf
<enddoc>
// Second output document
<begindoc>
duplicate=0,FileA.pdf
duplicate=0,FileB.pdf
document=Second-Size1.pdf
<enddoc>
// Third output document
<begindoc>
duplicate=2,FileA.pdf
duplicate=1,FileB.pdf
document=Third-Size1.pdf
<enddoc>
// repeat again for next size....

 

[PippaThePointer]

this worked perfectly. Ive made lots of other small changes to test a few things and to learn how all the bits work.
for instance if i have more columns i change the range and also "For I = 1 To 3' to 1 to 4. But i cant work out which offset to change in the 'Create Formatted text' section if for example the data was in different columns such as C,D,E. The reason is if i wanted to not have the formula in the spreadsheet but instead in the VBA then the data would potentilally look like below. and i would want to use your VBA but include something along the lines of "duplicate" & WS.Range("C2") & "," & WS.Range("B2")

Size	File	heading1	heading2	Heading3
A4	FileA.pdf	2​	4​	6​
A4	FileB.pdf	3​	5​	7​

Hi again,
This has been so helpfull but i am struggling a bit to understand how the the code works for the three kinds (B,C,D) and how to edit or unpick the range. Any chance you could give me an example without the repeat across the columns so it worked for just one column category? The data i get before someone messes with it is usually one worksheet per store anyway.
lets say the data came in like the following. Could you redo you original VBA example so it gave me the same thing and grouped by column A but only looked at range A2:B?

Group	QTY
A4-StoreA	duplicate=2,FileA.pdf
A4-StoreA	duplicate=2,FileB.pdf
A4-StoreB	duplicate=2,FileA.pdf
A4-StoreB	duplicate=2,FileB.pdf

 

[PippaThePointer]

One possibility

Sub MakeFile()
    Dim WB As Workbook
    Dim WS As Worksheet, WSD As Worksheet
    Dim rng As Range, R As Range, rng2 As Range
    Dim I As Long, LastRow As Long, DestRow As Long, DestColumn As Long
    Dim VA As Variant
    Dim DocName As String, LastSize As String, OutFile As String
    Dim inputfolder As String, outputfolder As String, reportfile As String, overwrite As String, padtoeven As String, author As String, title As String
   
    '===============User data ========================
    inputfolder = "C:\testfileinputlocation"
    'outputfolder = "C:\testfileoutputlocation"
    outputfolder = "C:\Users\223103252\Documents\TestFiles\"
    reportfile = "C:\testlogfilelocation\ProcessingLog.htm"
    overwrite = "no"
    padtoeven = "no"
    author = "Me"
    title = "filename"
   
    'Output File
    OutFile = outputfolder & "TestFile.Merge"
    '=================================================
    Application.ScreenUpdating = False
    Set WB = ActiveWorkbook
    Set WS = ActiveSheet
       
    'Add temporary worksheet and copy data to it.
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("$TempSheet").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
   
    Set WSD = ThisWorkbook.Worksheets.Add
    WSD.Name = "$TempSheet"
   
    With WS
        Set rng2 = .Range("A2:D" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    rng2.Copy WSD.Range("A1") 'copy data to temporary worksheet
   
    'create formatted text
    With WSD
        Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
        For Each R In rng
            For I = 1 To 3
                R.Offset(0, I).Value = R.Offset(0, I).Value & "$" & I
            Next I
        Next R
       
        For I = 2 To 3
            LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
            rng.Offset(, I).Resize(, 1).Cut .Cells(LastRow + 1, 2)
            rng.Copy .Cells(LastRow + 1, 1)
        Next I
       
        'Sort
        .UsedRange.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
       
        Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
       
        DestRow = 1
        DestColumn = 5
       
        'Write header information
        WriteLine WSD, "inputfolder  = " & inputfolder, DestRow, DestColumn
        WriteLine WSD, "outputfolder  = " & outputfolder, DestRow, DestColumn
        WriteLine WSD, "reportfile  = " & reportfile, DestRow, DestColumn
        WriteLine WSD, "overwrite  = " & overwrite, DestRow, DestColumn
        WriteLine WSD, "padtoeven  = " & padtoeven, DestRow, DestColumn
        WriteLine WSD, "author  = " & author, DestRow, DestColumn
        WriteLine WSD, "title  = " & title, DestRow, DestColumn
       
        'Build formatted text
        LastSize = ""
        For Each R In rng
            R.Value = R.Value & "$" & Right(R.Offset(, 1).Value, 1)
            With R.Offset(, 1)
                VA = Split(.Value, "$")
                .Value = VA(0)
            End With
            If LastSize = "" Then
                WriteLine WSD, "<begindoc>", DestRow, DestColumn
            ElseIf R.Value <> LastSize Then
                WriteLine WSD, DocName, DestRow, DestColumn
                WriteLine WSD, "<enddoc>", DestRow, DestColumn
                WriteLine WSD, "<begindoc>", DestRow, DestColumn
            End If
            WriteLine WSD, R.Offset(, 1).Value, DestRow, DestColumn
            VA = Split(R.Value, "$")
            Select Case VA(1)
                Case 1
                    DocName = "document=" & "First-" & VA(0) & ".pdf"
                Case 2
                    DocName = "document=" & "Second-" & VA(0) & ".pdf"
                Case 3
                    DocName = "document=" & "Third-" & VA(0) & ".pdf"
            End Select
            LastSize = R.Value
        Next R
       
        WriteLine WSD, DocName, DestRow, DestColumn
        WriteLine WSD, "<enddoc>", DestRow, DestColumn
       
        'Write to text file.
        Set rng = .Range(.Cells(1, DestColumn), .Cells(.Rows.Count, DestColumn).End(xlUp))
        Open OutFile For Output Access Write As #1     ' Open text file for write
        For Each R In rng
            Print #1, R.Value                          ' Write to output file
        Next R
        Close #1                                       ' Close file.
        .Columns.AutoFit
    End With
   
    'Clean up
    On Error Resume Next
    Application.DisplayAlerts = False
    WSD.Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Application.ScreenUpdating = True
   
    MsgBox "New file created:" & vbCr & vbCr & OutFile, vbOKOnly Or vbInformation, Application.Name
End Sub

Hi again,
This has been so helpfull but i am struggling a bit to understand how the the code works for the three kinds (B,C,D) and how to edit or unpick the range. Any chance you could give me an example without the repeat across the columns so it worked for just one column category? The data i get before someone messes with it is usually one worksheet per store anyway.
lets say the data came in like the following. Could you redo you original VBA example so it gave me the same thing and grouped by column A but only looked at range A2:B?

Group	QTY
A4-StoreA	duplicate=2,FileA.pdf
A4-StoreA	duplicate=2,FileB.pdf
A4-StoreB	duplicate=2,FileA.pdf
A4-StoreB	duplicate=2,FileB.pdf

 

[rlv01]

You are changing the requirements so much I'm not clear on what you are trying to do. Perhaps you could use the XL2BB add-in to post some better data?

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

 

[PippaThePointer]

You are changing the requirements so much I'm not clear on what you are trying to do. Perhaps you could use the XL2BB add-in to post some better data?

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

Sorry, I guess i'm trying to learn what you wrote so i can adapt it for different needs and i keep getting diffenent data from my source.
Good timing though, as now i realise that this example does not work if there is a formula in there. I was just tyring to work out how and where to amend that in the code. I think its in the 'add temp worksheet and copy and copy there' bit and needs some sort of "range.value' added in.

I will get a mini sheet up to you shortly. I have made up a new sheet that has more info on it but kept the 4 important columns i wanted at the end as i think i would eventually work out how to copy s2:V and go from there. But not with the formaula in it....

 

[PippaThePointer]

You are changing the requirements so much I'm not clear on what you are trying to do. Perhaps you could use the XL2BB add-in to post some better data?

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

I hope i have done this right. This is the demo spreadsheet i have created. The person who currently does this task, she has to manually paste in store a, b, c from individual spreadsheets, but the data she needs is only certain rows of that data, ie 31-100. I have some other macro that can promt to get file and pull data but im not sure yet that the supplied content is reliable so for now i left alone (mabey next topic). So once the data is copied here i want to then take those formula cells and run them into the txt file. Im still running through my head the best way within my expertise to solve this, but i thought if i had multipe macro and buttons i could for instance have macro for 'one store (a only)', two store (a and b), or three store (abc). Once i have the text file i can run that via either of two app servers i manage that either run xml, csv or text that will combine 1000s of pdf files, impose them and then run to schedule on a some impressive digital print hardware in colated sets. This xcell bit im trying to improve because there is so much manual input going on.

Template - Copy.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	(Will add macro button here….)						Store A			Store B			Store C			TOTALS			Script Data
2	Image Reference	Description	Filename	SIZE	12 KINDS		Store A 12 Pages	Store A 2 Sets		Store B 60 Pages	Store B 11 Sets		Store C 32 Pages	Store C 8 Sets		TOTALS 80 Pages	18 Sets		Size	Store A copies	Store B Copies	Store C Copies
3		File A	FileA.pdf	105x297	4		4	1		28	7		32	8		64	16		105x297	duplicate=1,FileA.pdf	duplicate=7,FileA.pdf	duplicate=8,FileA.pdf
4		File B	FileB.pdf	105x297	8		8	1		32	4		0	0		16	2		105x297	duplicate=1,FileB.pdf	duplicate=4,FileB.pdf
5					12		12	2		60	11		32	8		80	18
Sheet1

Cell Formulas
Range	Formula
E2	E2	=CONCATENATE(E5," KINDS")
H2,N2,K2	H2	=CONCATENATE(G1," ",H5," Sets")
Q2	Q2	=CONCATENATE(Q1," ",Q5," Sets")
Q3	Q3	=SUM(H3+K3+N3)
S3:S4	S3	=D3
T3:T4	T3	=IF(H3>0,CONCATENATE("duplicate=",H3,",",$C3),"")
U3:U4	U3	=IF(K3>0,CONCATENATE("duplicate=",K3,",",$C3),"")
V3:V4	V3	=IF(N3>0,CONCATENATE("duplicate=",N3,",",$C3),"")
G2,P2,M2,J2	G2	=CONCATENATE(G1," ",G5," Pages")
M3:M4,J3:J4,G3:G4	G3	=($E3*H3)
P3:P4	P3	=SUM(E3*Q3)
E5,P5:Q5,M5:N5,J5:K5,G5:H5	E5	=SUBTOTAL(109,E3:E4)

 

[rlv01]

Book3
	A	B	C	D
1	Size	First	Second	Third
2	Size1	duplicate=2,FileA.pdf	duplicate=0,FileA.pdf	duplicate=2,FileA.pdf
3	Size1	duplicate=0,FileB.pdf	duplicate=0,FileB.pdf	duplicate=1,FileB.pdf
4	Size2	duplicate=2,FileC.pdf	duplicate=2,FileC.pdf	duplicate=2,FileC.pdf
5	Size2	duplicate=2,FileD.pdf	duplicate=2,FileD.pdf	duplicate=2,FileD.pdf
6	Size2	duplicate=2,FileE.pdf	duplicate=2,FileE.pdf	duplicate=2,FileE.pdf
Sheet1

The post showing the larger spreadsheet structure is more information than I need. There is probably a lot of work you could do to better gather the data from each store an put it somewhere to better generate the text file, but that's waaaay beyond the scope of this problem and those other problems should be the subject of other threads.

The original set of data looked like the above and the task was to create a single ordered and sorted list from the three columns of data and the write that to a faux XML format text file. So the only thing I need to know is which columns match up to those and contain the data that is to be written to the text file. Say for example, this:

Book3
	S	T	U	V
1	Script Data
2	Size	Store A copies	Store B Copies	Store C Copies
3	105x297	duplicate=1,FileA.pdf	duplicate=7,FileA.pdf	duplicate=8,FileA.pdf
4	105x297	duplicate=1,FileB.pdf	duplicate=4,FileB.pdf
Sheet2

Cell Formulas
Range	Formula
S3:S4	S3	=D3
T3:T4	T3	=IF(H3>0,CONCATENATE("duplicate=",H3,",",$C3),"")
U3:U4	U3	=IF(K3>0,CONCATENATE("duplicate=",K3,",",$C3),"")
V3:V4	V3	=IF(N3>0,CONCATENATE("duplicate=",N3,",",$C3),"")

The code would be something like this. It does not matter if the cells contain formulas.

Sub MakeFile()
    Dim WB As Workbook
    Dim WS As Worksheet, WSD As Worksheet
    Dim rng As Range, R As Range, rng2 As Range
    Dim FirstDataCol As String, LastDataCol As String
    Dim FirstDataRow As Long
    Dim I As Long, LastRow As Long, DestRow As Long, DestColumn As Long
    Dim VA As Variant
    Dim DocName As String, LastSize As String, OutFile As String
    Dim inputfolder As String, outputfolder As String, reportfile As String, overwrite As String, padtoeven As String, author As String, title As String

    Sheets("Sheet2").Activate

    '===============User data ========================
    inputfolder = "C:\testfileinputlocation"
    outputfolder = "C:\testfileoutputlocation"
    reportfile = "C:\testlogfilelocation\ProcessingLog.htm"
    overwrite = "no"
    padtoeven = "no"
    author = "Me"
    title = "filename"

    'Output File
    OutFile = outputfolder & "TestFile.Merge"
    '=================================================
    Application.ScreenUpdating = False
    Set WB = ActiveWorkbook
    Set WS = ActiveSheet

    'Add temporary worksheet and copy data to it.
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("$TempSheet").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set WSD = ThisWorkbook.Worksheets.Add
    WSD.Name = "$TempSheet"

    'Define the columns containing the relevant data here.
    FirstDataCol = "S"
    LastDataCol = "V"
    FirstDataRow = 3

    With WS
        Set rng2 = .Range(FirstDataCol & FirstDataRow & ":" & LastDataCol & .Range(FirstDataCol & .Rows.Count).End(xlUp).Row)
    End With

    rng2.Copy
    WSD.Range("A2").PasteSpecial (xlPasteValues)      'copy data to temporary worksheet
    WSD.Columns.AutoFit

    'create formatted text
    With WSD
        Set rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        rng.Range("A1").Offset(-1, 0).Value = 0
        For Each R In rng
            For I = 1 To rng2.Columns.Count - 1
                rng.Range("A1").Offset(-1, I).Value = I
                If Trim(R.Offset(0, I).Value) = "" Then
                    R.Offset(0, I).Value = "Delete"
                Else
                    R.Offset(0, I).Value = R.Offset(0, I).Value & "$" & I
                End If
            Next I
        Next R

        For I = 2 To rng2.Columns.Count - 1
            LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
            rng.Offset(, I).Resize(, 1).Cut .Cells(LastRow + 1, 2)
            rng.Copy .Cells(LastRow + 1, 1)
        Next I

        'Sort
        .UsedRange.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes

        Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))

        'Delete empty cells
        With rng.Resize(, 2)
            .AutoFilter Field:=2, Criteria1:="=Delete"
            If Not .SpecialCells(xlCellTypeVisible) Is Nothing Then
                .SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End If
        End With
        .AutoFilterMode = False

        DestRow = 1
        DestColumn = 10

        'Write header information
        WriteLine WSD, "inputfolder  = " & inputfolder, DestRow, DestColumn
        WriteLine WSD, "outputfolder  = " & outputfolder, DestRow, DestColumn
        WriteLine WSD, "reportfile  = " & reportfile, DestRow, DestColumn
        WriteLine WSD, "overwrite  = " & overwrite, DestRow, DestColumn
        WriteLine WSD, "padtoeven  = " & padtoeven, DestRow, DestColumn
        WriteLine WSD, "author  = " & author, DestRow, DestColumn
        WriteLine WSD, "title  = " & title, DestRow, DestColumn

        'Build formatted text
        LastSize = ""
        For Each R In rng
            R.Value = R.Value & "$" & Right(R.Offset(, 1).Value, 1)
            With R.Offset(, 1)
                VA = Split(.Value, "$")
                .Value = VA(0)
            End With
            If LastSize = "" Then
                WriteLine WSD, "<begindoc>", DestRow, DestColumn
            ElseIf R.Value <> LastSize Then
                WriteLine WSD, DocName, DestRow, DestColumn
                WriteLine WSD, "<enddoc>", DestRow, DestColumn
                WriteLine WSD, "<begindoc>", DestRow, DestColumn
            End If
            WriteLine WSD, R.Offset(, 1).Value, DestRow, DestColumn
            VA = Split(R.Value, "$")
            Select Case VA(1)
            Case 1
                DocName = "document=" & "First-" & VA(0) & ".pdf"
            Case 2
                DocName = "document=" & "Second-" & VA(0) & ".pdf"
            Case 3
                DocName = "document=" & "Third-" & VA(0) & ".pdf"
            End Select
            LastSize = R.Value
        Next R

        WriteLine WSD, DocName, DestRow, DestColumn
        WriteLine WSD, "<enddoc>", DestRow, DestColumn

        'Write to text file.
        Set rng = .Range(.Cells(1, DestColumn), .Cells(.Rows.Count, DestColumn).End(xlUp))
        Open OutFile For Output Access Write As #1    ' Open text file for write
        For Each R In rng
            Print #1, R.Value                         ' Write to output file
        Next R
        Close #1                                      ' Close file.
        .Columns.AutoFit
    End With

    'Clean up
    On Error Resume Next
    Application.DisplayAlerts = False
    WSD.Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Application.ScreenUpdating = True

    MsgBox "New file created:" & vbCr & vbCr & OutFile, vbOKOnly Or vbInformation, Application.Name
End Sub

Private Sub WriteLine(DestWS As Worksheet, WriteStr As String, ByRef DestRow As Long, ByRef DestColumn As Long)
    DestWS.Cells(DestRow, DestColumn).Value = WriteStr
    DestRow = DestRow + 1
End Sub

 

[rlv01]

The best way to understand the function is to comment out the line below and then use the debugger to single step though the code while watching the temporary sheet.

  'Clean up
    On Error Resume Next
    Application.DisplayAlerts = False
    'WSD.Delete                                                                <-- temporarily comment out. 
    Application.DisplayAlerts = True
    On Error GoTo 0
    Application.ScreenUpdating = True

 

[PippaThePointer]

The best way to understand the function is to comment out the line below and then use the debugger to single step though the code while watching the temporary sheet.

  'Clean up
    On Error Resume Next
    Application.DisplayAlerts = False
    'WSD.Delete                                                                <-- temporarily comment out.
    Application.DisplayAlerts = True
    On Error GoTo 0
    Application.ScreenUpdating = True

Hi Riv,
I posted a new question based on this fantastic code you helped me with.
You might have a quicker answer for me.

help with Select Case in VBA Macro

Hi, I have a VBA Macro that i have been working on based on some awsome input from riv01 on this site. Ive been picking it appart and learning how each bit works and making changes but im stuck on the select case that i have in here as it will only go up to 9. What it does near the end of the...

www.mrexcel.com