Create a single .csv from multiple worksheets

[mpolitte]

Hello again,

Is there an easy way to create a single .csv file from multiple worksheets, for I'd like to join multiple worksheets. The first character in the .csv indicates the sheet it comes from so my parser is able to handle disparate data in a single file. I imagine VBA code is in order to accomplish this task. Are there any API/function calls that make this a simple task? As always thanks for your help!

Maureen

[Kenneth Hobs]

If you attach a short xls with a few sheets and data, it would be easier to help. Obviously, your sheets should have the same number of columns with data for each sheet to make into one csv file.

[mpolitte]

Ah, only two of my three sheets have the same number of columns. Is that really a show stopper if custom VBA code must be written? How difficult is to add a button to my excel worksheet titled "Create CSV" to trigger VBA code that would join three worksheets into a single csv?

Thank You!

[Kenneth Hobs]

CSV files can be thought of as database files. As such, they should have structure. In reality, they are just text files so yes, you can do what you want but it comes at a cost.

Since you are combining discontinuous data like that, I suppose you don't want the first line to contain fieldnames since that would not make sense for your scenario?

[Kenneth Hobs]

While this does what you asked for, it may not do what you "want" for the reasons that I stated earlier. e.g. See your Polling columns. It is column B on one sheet and column C on 2 other sheets.

Most likely you will need to also cleanup your data by deleting the rows that are NOT fully complete.

I used Excel methods rather than traditional text file writing methods. You will need to modify string for csvPathName and such. Always backup your data before trying new code.
[vba]Sub CreateCSVFromXLSsheets()
Dim xlsheet As Excel.Worksheet
Dim xlbook As Excel.Workbook
Dim r As Excel.Range, r2 As Excel.Range
Dim sht As Excel.Worksheet
Dim nr As Long
Dim csvPathName As String

csvPathName = ActiveWorkbook.Path & "\Test.csv"

On Error GoTo theEnd
'Speed routines, http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

Application.ScreenUpdating = False
Set xlbook = Application.Workbooks.Add
Set xlsheet = xlbook.Worksheets.Add

xlsheet.Name = "CSV"
For Each sht In ThisWorkbook.Worksheets
nr = LastNBRow(xlsheet.UsedRange) + 1
Set r = xlsheet.Range("A" & nr)
Set r2 = ThisWorkbook.Worksheets(sht.Name).Range(RangeLR1(sht.UsedRange).Address)
r.Resize(r2.Rows.Count, r2.Columns.Count).Value = r2.Value
Next sht

On Error Resume Next
'Delete old csv file if it exists
Kill csvPathName
On Error GoTo theEnd
xlbook.SaveAs Filename:=csvPathName, FileFormat:=xlCSVMSDOS, CreateBackup:=False
xlbook.Close False

theEnd:
On Error Resume Next
Set xlsheet = Nothing
Set xlbook = Nothing
SpeedOff

'Open csv file to see if it was created ok.
Shell "cmd /c " & """" & csvPathName & """"
End Sub

'=LastNBRow(A3:G10)
Function LastNBRow(rng As Range) As Long
Dim LastRow As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = rng.Find(What:="*", After:=rng.Cells(rng.Rows.Count, rng.Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
LastNBRow = LastRow
End Function

Function RangeLR1(aRange As Range) As Range
Set RangeLR1 = Range(Cells(aRange.Row + 1, aRange.Column), Cells(aRange.Rows.Count, aRange.Columns.Count))
End Function

[/vba]

[mpolitte]

Ken, Your code worked flawlessly, thank you! My data seems to be giving me fits, however. In my second column I have data formatted as text with values of 1:1 to 1:64 and 2:1 to 2:64. The values of 1:6x and 2:6x are all being saved in the csv as numerics (floats) instead of text. If I put 1:60 in any cell in column B the csv file will store a float. Any idea on why my data is being converted? Also, you'll notice I added a "Create CSV" button which triggers your much appreciated code! Thanks, as always.

Maureen

[Kenneth Hobs]

The problem lies with Excel in its attempt to format the cells based on the column's numeric format. Like a database, it prefers data to be in the same format though unlike a database, you can force specific formats. Well, that is my spin on it. It is why I made my first comment.

We can sort of get what you want by writing to a text file as shown in this example. However, you are still left with the same issue if you open that csv file in Excel. In Notepad, it should format as you expect.

You might have better luck importing to Excel for your csv data if you used "1 to 60" or "1 : 60" or "1_60" rather than "1:60" for those types of column data.

As stated earlier, I recommend that you clean up your data. If you press Ctrl+End on each sheet, you will see the actual UsedRange. If you need to add formatting for the user, you can add a button that lets them create a new row or use the Change event to format the new rows or delete blank rows as needed.

In this example, be sure to add the reference as shown in strClip(). You can make this a bit faster if you use the parts of the Append routine. It is a bit inefficient to open and close the csv file several times. This routine may fail for very large blocks of cells. For that case, one would write each row in the UsedRange separately to the csv file. I also added a routine to trim x number of rows from a range.

[vba]Sub AppendSheetsToCSV()
Dim rc As Boolean
Dim csvPathName As String
Dim sht As Worksheet

csvPathName = ActiveWorkbook.Path & "\Test.csv"

On Error Resume Next
'Speed routines, http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

'Delete old csv file if it exists
Kill csvPathName
'On Error GoTo TheEnd

For Each sht In Worksheets
Worksheets(sht.Name).Range(RangeLRx(sht.UsedRange, 2).Address).Copy
'Debug.Print Worksheets(sht.Name).Range(RangeLRx(sht.UsedRange, 2).Address).Address
'Replace tab characters, added between cells, with a comma.
rc = AppendToTXTFile(csvPathName, Replace(strClip, vbTab, ","))
Next sht

'Open csv file in Notepad to see if it was created ok.
Shell "cmd /c Notepad " & """" & csvPathName & """"

'Open in Excel. May not be the same as in Notepad due to reformatting.
'Shell "cmd /c " & """" & csvPathName & """"
TheEnd:
Application.CutCopyMode = False
SpeedOff
End Sub


Function AppendToTXTFile(strFile As String, strData As String) As Boolean
Dim iHandle As Integer
iHandle = FreeFile
Open strFile For Append Access Write As #iHandle
Print #iHandle, strData
Close #iHandle
AppendToTXTFile = True
End Function


Function strClip(Optional TrimVBLF As Boolean = True) As String
'Tools > Reference > Microsoft Forms 2.0 Object Library, FM20.dll
Dim MyData As DataObject, s As String
On Error Resume Next
Set MyData = New DataObject
MyData.GetFromClipboard
s = MyData.GetText
If TrimVBLF Then
If Asc(Right(s, 1)) = 10 Then s = Left(s, Len(s) - 2) 'Trim trailing vbLf character if needed.
End If
strClip = s
End Function


'Trim the first x number of rows
Function RangeLRx(aRange As Range, Optional x As Integer = 1) As Range
Set RangeLRx = Range(Cells(aRange.Row + x, aRange.Column), Cells(aRange.Rows.Count, aRange.Columns.Count))
End Function
[/vba]

[mpolitte]

Thanks Ken. I opted to "clean up" my data. That seemed the most prudent thing to do, especially when the colon adds or has no value to the application parsing the .csv.

[mpolitte]

I validate a cell containing string data (text). In particular, I am checking to see if the string contains a comma. Here's the scenario: after the user hits enter, validation is performed. If the string contains a comma, I want to display a pop-up asking the user to remove the comma and I want the invalid cell to remain active. I have attached the code and included it here. The code is in Sheet 1 (Data Items). Also is there a strlen function call such that I can ensure that the text string is less than 32 characters? As always thanks for your help!

'*************************************************************
'Check to see if the Description field contains a comma
If Not Intersect(Target, Me.Range(Description_Range)) Is Nothing Then
'desc_string = cell.Value

If InStr(Target.Value, ",") Then
MsgBox ("The description field contains a comma, please remove it!")
Target.Cells.Activate
End If
End If
'***************************************************************

[Kenneth Hobs]

While we can do it with vba, why not just use data validation? A third option might be to set or clear a validation in the Change event.