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 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.
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.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.