Exporting Excel data as CSV with VBA does not export correct file type and cell values

Question

I have an Excel file which should have the following functionality:

User selects a range and clicks the export button, this should generate a CSV file with a specific title including the date, like "annual_25.03.2022" with the cells holding the values only, as in the Excel file, the cells all have formulas.

playerNr | amount | reason | expireDate | ProductType | ProductItem

13661748 | 100 | ANNIVERSARY | 2022-04-19T23:59:00 |All | All

All of the rows have formulas behind them. The problems I am encountering are:

• The first two rows playerNr and amount are not exported as values, but the formula behind the cells.
• The created file does not have the desired name, it's just the standard format(new book)
• The created file has the Excel extension instead of CSV
• The export button is on the new file too, even though I do not select it, I would like to delete that on the new file, the export button should only be on the Excel template.

The VBA looks like this:

Sub ExportSelectedData()


ActiveSheet.Unprotect



Dim Rng As Range

Dim WorkRng As Range

Dim xFile As Variant

Dim xFileString As String

On Error Resume Next

xTitleId = "Check your selection"

 Set WorkRng = Application.Selection

Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

Application.ActiveSheet.Copy

Application.ActiveSheet.Cells.Clear

'Application.ActiveSheet.PasteSpecial Paste:=xlPasteValues

WorkRng.Copy Application.ActiveSheet.Range("A1")

Set xFile = CreateObject("Scripting.FileSystemObject")

xFileString = Application.GetSaveAsFilename("Anniversaries " & Format(Date, "dd-mm-yyyy"), filefilter:="Comma Separated Text (*.CSV), *.CSV")

Application.ActiveWorkbook.SaveAs FileName:=xFileString, FileFormat:=xlCSV, CreateBackup:=False

ActiveSheet.Protect



End Sub

So I am not sure how to paste only the values and why the string for the new file is wrong, I have tried various approaches and none of them worked.

Also, I have no idea why the export button remains on the new file, and the sheet protection seems to work only randomly.

After the suggestions, I have ran the following code:

Sub ExportSelectedData()

Dim Rng As Range

Dim WorkRng As Range

Dim xFile As Variant

Dim ws as Worksheet

Set ws = ActiveSheet

ws.Unprotect

Dim xFileString As StringOn Error Resume Next

xTitleId = "Check your selection"

Set WorkRng = Application.Selection

Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

For Each sh In ActiveSheet.Shapes: sh.Delete: Next

ActiveSheet.Range("A1").Resize(WorkRng.rows.count, WorkRng.Columns.count).value = WorkRng.value

ws.Protect

Set xFile = CreateObject("Scripting.FileSystemObject")

xFileString = Application.GetSaveAsFilename("Anniversaries " & Format(Date, "dd-mm-yyyy"), filefilter:="Comma Separated Text (*.CSV), *.CSV")

Application.ActiveWorkbook.SaveAs FileName:=xFileString, FileFormat:=xlCSV, CreateBackup:=False

Debug.Print xFileString:Stop



End Sub

The debug shows "" in immediate window, there is no new file generated with the above.

Answer 1

Please, try the next code, which should be working as (I understood) you need:

Sub ExportSelectedData()
 Dim ws As Worksheet, sh As Worksheet, shP As Shape
 Dim WorkRng As Range, xFileString As String, xTitleId As String
 
 Set ws = ActiveSheet: ws.Unprotect

 xTitleId = "Please, select the range to place it in the .CSV document!"

 Set WorkRng = Application.InputBox("Range", xTitleId, , Type:=8)
 ws.Copy 'create a workbook containing the former active sheet
 Set sh = ActiveWorkbook.Worksheets(1)
 sh.cells.Clear 'clear the content of the newly created workbook, active sheet
 For Each shP In ActiveSheet.Shapes: shP.Delete: Next 'delete all existing sheets

 'copy the necessary range as value:
 sh.Range("A1").Resize(WorkRng.rows.count, WorkRng.Columns.count).value = WorkRng.value

 'choose the folder where to save the csv and build its name:
 xFileString = GetFolderPath(ThisWorkbook.path)
 xFileString = xFileString & Application.PathSeparator & "Anniversaries " & Format(Date, "dd-mm-yyyy") & ".CSV"
 Debug.Print xFileString: Stop 'check if the path has been correctly built. If yes, press F5

 'save the active document using the above settled name:
 ActiveWorkbook.saveas fileName:=xFileString, FileFormat:=xlCSV, local:=False, CreateBackup:=False
 'ActiveWorkbook.close False 'uncomment this line after confirmation that it works as you need...
 ws.Protect
End Sub

Edited:

For using the code on MAC, please try the next function giving the possibility to select folder and returning its path:

Private Function GetFolderPath(Optional strPath As String) As String
Dim Fldr As FileDialog
Dim sItem As String
 Set Fldr = Application.FileDialog(msoFileDialogFolderPicker)
 With Fldr
    .Title = "Select a Folder to build the SaveAs name!"
    .AllowMultiSelect = False
    If strPath <> "" Then .InitialFileName = strPath 'the folder where the dialog to open
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
 End With
NextCode:
 GetFolderPath = sItem
 Set Fldr = Nothing
End Function

It can be tested in the next way:

Sub testGetFldPath()
  Dim foldPath As String
    foldPath = GetFolderPath(ThisWorkbook.path)
    foldPath = foldPath & Application.PathSeparator & "Anniversaries " & Format(Date, "dd-mm-yyyy") & ".CSV"
    Debug.Print foldPath
End Sub

I will adapt the initial code to use it.