1

I'm looking for a VBA Macro to export data to a csv. I found this code which after some tweaking does a great job. However, when copying from a range, Excel seems to ignore hidden columns while I want the CSV to contain all the columns. Has anyone discovered concise way to code this?

Here is the code I have so far:

Sub ExportListOrTable(Optional newBook As Boolean, Optional willNameSheet As Boolean, Optional asCSV As Boolean, Optional visibleOnly As Boolean)
'Sub CopyListOrTable2NewWorksheet()
'Works in Excel 2003 and Excel 2007. Only copies visible data.
'code source: https://msdn.microsoft.com/en-us/library/dd637097%28v=office.11%29.aspx
'improved by: Tzvi
'   - replaced new worksheet with new workbook

'params:
'   newBook: To create a new new sheet in the current workbook or (default) in a new workbook
'   willNameSheet: To offer the user to name the sheet or (default) leave the default names
'   asCSV: not implemented - will always save as CSV
'   visibleOnly: to filter out any hidden columns - default false

'TODO
'   -add parameter list for following options:
'   - if table was not selected, copy activesheet.usedRange
'   - optional saveFileType
'   -


Dim New_Ws As Worksheet
Dim ACell, Data As Range
Dim CCount As Long
Dim ActiveCellInTable As Boolean
Dim CopyFormats, retrySave As Variant
Dim sheetName, user, defaultFileName, fileSaveName As String
Dim userChoice As Boolean

'Check to see if the worksheet or workbook is protected. TODO this may not be necessary anymore
If ActiveWorkbook.ProtectStructure = True Or ActiveSheet.ProtectContents = True Then
    MsgBox "This macro will not work when the workbook or worksheet is write-protected."
        Exit Sub
    End If

    'Set a reference to the ActiveCell. You can always use ACell to
    'point to this cell, no matter where you are in the workbook.
    Set ACell = activeCell

    'Test to see if ACell is in a table or list. Note that by using ACell.ListObject, you
    'do not need to know the name of the table to work with it.
    On Error Resume Next
    ActiveCellInTable = (ACell.ListObject.Name <> "")
    On Error GoTo 0

    'TODO here we will select the fields to export
    'If the cell is in a list or table run the code.
    If ActiveCellInTable = True Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        If visibleOnly = True Then
            'Test if there are more than 8192 separate areas. Excel only supports
            'a maximum of 8,192 non-contiguous areas through VBA macros and manual.
            On Error Resume Next
            With ACell.ListObject.ListColumns(1).Range 'TODO remove this "with"
                CCount = .SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
            End With
            On Error GoTo 0

            If CCount = 0 Then
                MsgBox "There are more than 8192 individual areas, so it is not possible to " & _
                       "copy the visible data to a new worksheet. Tip: Sort your " & _
                       "data before you apply the filter and try this macro again.", _
                       vbOKOnly, "Copy to new worksheet"
                Exit Sub
            Else
                'Copy the visible cells.
                ACell.ListObject.Range.Copy
            End If
        Else
            'The user indicated he wants to copy hidden columns too.
            '**********************************************************
            'HOW DO I PROPERLY IMPLEMENT THIS PART?
            '**********************************************************

            MsgBox ("You wanted to copy hidden columns too?")
            ActiveSheet.UsedRange.Copy
        End If
    Else
'        MsgBox "Select a cell in your list or table before you run the macro.", _
'           vbOKOnly, "Copy to new worksheet"
        userChoice = MsgBox("A Table/Table protion is not selected. Do you want to export the entire page?", vbYesNo)
        If userChoice = False Then Exit Sub
        ActiveSheet.UsedRange.Copy
        'Exit Sub
    End If
            'Add a new Worksheet/WorkBook.
            If newBook = False Then
                Set New_Ws = Worksheets.Add(after:=Sheets(ActiveSheet.Index))
            Else
                Set New_Ws = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
            End If

            'Prompt the user for the worksheet name.
            If willNameSheet = True Then
                sheetName = InputBox("What is the name of the new worksheet?", _
                                     "Name the New Sheet")

                On Error Resume Next
                New_Ws.Name = sheetName
                If Err.Number > 0 Then
                    MsgBox "Change the name of sheet : " & New_Ws.Name & _
                         " manually after the macro is ready. The sheet name" & _
                         " you typed in already exists or you use characters" & _
                         " that are not allowed in a sheet name."
                    Err.Clear
                End If
                On Error GoTo 0
            End If

            'Paste the data into the new worksheet.
            With New_Ws.Range("A1")
                .PasteSpecial xlPasteColumnWidths
                .PasteSpecial xlPasteValuesAndNumberFormats
                .Select
                Application.CutCopyMode = False
            End With

            Application.ScreenUpdating = False

            'If you did not create a table, you have the option to copy the formats.
            If ActiveCellInTable = False Then
                Application.Goto ACell
                CopyFormats = MsgBox("Do you also want to copy the Formatting?", _
                                     vbOKCancel + vbExclamation, "Copy to new worksheet")
                If CopyFormats = vbOK Then
                    ACell.ListObject.Range.Copy
                    With New_Ws.Range("A1")
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
                End If
            End If

        'Select the new worksheet if it is not active.
        Application.Goto New_Ws.Range("A1")

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With

        'Now we're ready to save our new file as excel format
        defaultFileName = ActiveWorkbook.Name
        user = Environ("userprofile")

'marker getfilename: to return to if we need to look for a new filename
getfilename:
        ChDir user & "\Desktop"
        fileSaveName = Application.GetSaveAsFilename(defaultFileName & ".csv", "Comma Delimited Format (*.csv), *.csv")

        If fileSaveName <> "False" Then
            'error handling for 'file already exists and the user clicks 'no'
            On Error Resume Next
            ActiveWorkbook.SaveAs fileName:=fileSaveName, FileFormat:=xlCSV, ReadOnlyRecommended:=True, CreateBackup:=False, ConflictResolution:=xlUserResolution
            If Err.Number = 1004 Then
                'Offer user two options: To try a different filename or cancel the entire export
                retrySave = MsgBox(Err.Description, vbRetryCancel, "Error creating file")
                If retrySave = vbRetry Then
                    GoTo getfilename
                Else
                    GoTo cancelprocedure
                End If
            End If
            On Error GoTo 0
        Else
            GoTo cancelprocedure
        End If

Exit Sub
cancelprocedure:
    ActiveWorkbook.Close saveChanges:=False
    Exit Sub
End Sub

Update:

In response to shagans concern. The parameter list on line one is intended to be set by another Macro as such:

Sub ExportVisibleAsCSV
    Call ExportListOrTable(newBook:=True, willNameSheet:=False, asCSV:=True, visibleOnly:=True)
End Sub
tzvi
  • 471
  • 3
  • 5
  • 19

2 Answers2

2

Updating now that example code is available:

Ok looking at the code you posted, I see a bool named visibleOnly but I don't see where it gets set. Your ability for the logic to reach UsedRange.Copy entirely depends on that being set to false. The comment above ACell.ListObject.Range.Copy indicates that if you reach that statement you are only copying visible cells. In order to copy the hidden cells, visibleOnly would need to be set to false (bypassing the rest of the CCount stuff). So I would be interested in knowing how that bool is set and checking to see what its value is set to when you are running your code.

Update 2:

You need to set the value of your visibleOnly boolean somehow.

here's some code I edited that creates a message box that allows the user to say "yes" or "no" to "do you want to copy hidden data too?" that answer will dictate the value of visibleOnly which in turn dictates which flow they enter.

In addition to that, your assumption that ACell.ListObject.Range.Copy would only copy visible cells appears to have been incorrect. Instead that is being replaced with the specialcell type for visible cells.

Finally, vbYesNo does not actually return a boolean value. Instead it returns vbYes or vbNo which are vb type enumerators (value 6 and 7 respectively). So setting a bool to the value of a vbYesNo will always return True (as a value exists and essentially it just evaluates iferror).

So I changed that bit as well so it now properly checks the Yes/No condition on your userchoice (which is no longer a bool).

here's the code:

Dim ACell, Data As Range
Dim CCount As Long
Dim ActiveCellInTable As Boolean
Dim CopyFormats, retrySave As Variant
Dim sheetName, user, defaultFileName, fileSaveName As String


'Check to see if the worksheet or workbook is protected. TODO this may not be necessary anymore
If ActiveWorkbook.ProtectStructure = True Or ActiveSheet.ProtectContents = True Then
    MsgBox "This macro will not work when the workbook or worksheet is write-protected."
        Exit Sub
    End If

    'Set a reference to the ActiveCell. You can always use ACell to
    'point to this cell, no matter where you are in the workbook.
    Set ACell = ActiveCell

    'Test to see if ACell is in a table or list. Note that by using ACell.ListObject, you
    'do not need to know the name of the table to work with it.
    On Error Resume Next
    ActiveCellInTable = (ACell.ListObject.Name <> "")
    On Error GoTo 0

    'TODO here we will select the fields to export
    'If the cell is in a list or table run the code.
    If ActiveCellInTable = True Then
        CopyHidden = MsgBox("Would you like to copy hidden data also?", vbYesNo, "Copy Hidden Data?")
        If CopyHidden = vbYes Then
            visibleOnly = False
        ElseIf CopyHidden = vbNo Then
            visibleOnly = True
        End If

        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        If visibleOnly = True Then
            'Test if there are more than 8192 separate areas. Excel only supports
            'a maximum of 8,192 non-contiguous areas through VBA macros and manual.
            On Error Resume Next
            With ACell.ListObject.ListColumns(1).Range 'TODO remove this "with"
                CCount = .SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
            End With
            On Error GoTo 0

            If CCount = 0 Then
                MsgBox "There are more than 8192 individual areas, so it is not possible to " & _
                       "copy the visible data to a new worksheet. Tip: Sort your " & _
                       "data before you apply the filter and try this macro again.", _
                       vbOKOnly, "Copy to new worksheet"
                Exit Sub
            Else
                'Copy the visible cells.
                ACell.ListObject.Range.SpecialCells(xlCellTypeVisible).Copy
                ' Only visible cells within the table are now in clipboard
            End If
        Else
            'The user indicated he wants to copy hidden columns too.
            MsgBox ("You wanted to copy hidden columns too?")
            ACell.ListObject.Range.Copy
            ' All table data cells including hidden are now in clipboard
        End If
    Else
'        MsgBox "Select a cell in your list or table before you run the macro.", _
'           vbOKOnly, "Copy to new worksheet"
        userChoice = MsgBox("A Table/Table protion is not selected. Do you want to export the entire page?", vbYesNo)
        If userChoice = vbNo Then Exit Sub
        ActiveSheet.UsedRange.Copy
        'Entire sheet range is now in clipboard (this is not always accurate)
        'Exit Sub
    End If
shagans
  • 232
  • 3
  • 12
  • I appreciate you spending the time to research my issue. The line of code you are referring to does not affect the 'copy' The comment above the line you mentioned explains that section of code is counting the amount of separate areas that are visible. If there are more than 8192 an error message is shown . Otherwise 'ListObject.Range.Copy' is called which seems to copy the entire Range. It only is applied to the visible ones though. I'll post the current version of my code above. – tzvi Apr 14 '15 at 22:59
  • You have properly read my code. visibleOnly is a **parameter** in the first line. I added the If statement later on to bypass the original copy command if `visibleOnly == false`. I have been asking for help in implementing the proper method of accomplishing this. Note the abnormal `MsgBox` there and `ActiveSheet.UsedRange.Copy` will not be limited to the Table, and will also ignore hidden columns. I will edit the code above to clarify. – tzvi Apr 15 '15 at 17:04
  • Try out the code I updated my answer with. It worked for me with multiple tables with varying complexity and a wide range of hidden/visible conditions. I only tried it copying to a sheet within the same workbook, so this is only troubleshooting the hidden/visible data issue – shagans Apr 15 '15 at 17:58
  • You are absolutely right. The hidden cells had been copied all along. I guess I had been believing the comment on MS site (see link in original post) that only visible cells were copied, which was corroborated in those columns not being visible in the new workbook. In actuality, they existed, but were still hidden. In a csv! Regarding the visiblrOnly, I would be calling this Sub from other subs which would set those arguments as needed. I'll edit the post accordingly. – tzvi Apr 15 '15 at 18:26
2

Assign the Value of the range to your target range instead of using the .Copy method:

Sub ExportCSV(source As Range, filename As String)

    Dim temp As Workbook
    Set temp = Application.Workbooks.Add

    Dim sheet As Worksheet
    Set sheet = temp.Worksheets(1)

    Dim target As Range
    'Size the target range to the same dimension as the source range.
    Set target = sheet.Range(sheet.Cells(1, 1), _
                 sheet.Cells(source.Rows.Count, source.Columns.Count))
    target.Value = source.Value

    temp.SaveAs filename, xlCSV
    temp.Close False

End Sub

This also has the benefit of not nuking whatever the user might have on the clipboard.

Comintern
  • 21,855
  • 5
  • 33
  • 80