I have a sheet in a workbook I would like to export to a csv file that gets updated every week. So ideally, I want the VBA code to export whatever data is in the sheet and overwrite what was existing in the path. The range of data is from A to AJ. The path of the folder will be on "C:\Users\HS"
I tried to adapt @VBasic2008 code at the location below to no avail.
EXCEL-VBA How to export to a CSV... a custom range of columns?
The result displays/flashes on the screen when I run it but doesn't get saved at the location specified.
Here is exactly what I had:
Option Explicit
Sub ExportColumnsToCSV()
Const sfRow As Long = 1
Const sColsList As String = "A:AJ"
Const dFirst As String = "A1"
Dim sCols() As String: sCols = Split(sColsList, ",")
Dim sws As Worksheet: Set sws = ActiveSheet
Dim swb As Workbook: Set swb = sws.Parent
Dim srrg As Range
Dim slCell As Range
Dim srCount As Long
With sws.Rows(sfRow)
Set slCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , xlByRows, xlPrevious)
If slCell Is Nothing Then
MsgBox "No data in worksheet.", vbCritical, "Export to CSV"
Exit Sub
End If
srCount = slCell.Row - .Row + 1
Set srrg = .Resize(srCount)
End With
Dim srg As Range
Dim n As Long
For n = 0 To UBound(sCols)
If srg Is Nothing Then
Set srg = Intersect(srrg, sws.Columns(sCols(n)))
Else
Set srg = Union(srg, Intersect(srrg, sws.Columns(sCols(n))))
End If
Next n
Dim dwb As Workbook: Set dwb = Application.Workbooks.Add
srg.Copy
dwb.Worksheets(1).Range(dFirst).PasteSpecial xlPasteValues
Dim dFolderPath As String: dFolderPath = swb.Path & "C:\Users\HS"
On Error Resume Next
MkDir dFolderPath
On Error GoTo 0
Dim dFilePath As String
dFilePath = dFolderPath _
& Left(swb.Name, InStrRev(swb.Name, ".") - 1) & ".csv"
' Optionally, out-comment previous line and uncomment next one
' to save with the current worksheet name.
'dFilePath = dFolderPath & sws.Name & ".csv"
Application.DisplayAlerts = False
dwb.SaveAs Filename:=dFilePath, FileFormat:=xlCSVUTF8, Local:=False
dwb.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Thank you HS
Here is an update with all previously mentioned comments and your recent request
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If TodayIsTheDay Then
ExportColumnsToCSV
End If
End Sub
Private Property Get TodayIsTheDay() As Boolean
' = 5 would be Friday
' = 6 would be Saturday
' = 1 would be Monday so on and so forth
If Weekday(Date, vbMonday) = 5 Then TodayIsTheDay = True
End Property
Private Sub ExportColumnsToCSV()
Dim wsTheWorksheetYouWant As Worksheet
' This is where you are going to change the worksheet name to the name you need
Set wsTheWorksheetYouWant = Application.Worksheets("yourWorksheetName")
Dim lBottomRow As Long
On Error Resume Next
lBottomRow = wsTheWorksheetYouWant.Range("$A:$A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
On Error GoTo 0
If lBottomRow <= 1 Then
' This assumes there is no data but still has coulmn headers.
MsgBox "there is only 1 row of data here"
Else
Dim rngTheRangeYouWant as range
Set rngTheRangeYouWant = wsTheWorksheetYouWant.Range("$A$1:$AJ$" & lBottomRow)
With rngTheRangeYouWant
Dim oNewWorkbook As Workbook
Set oNewWorkbook = Application.Workbooks.Add
rngTheRangeYouWant.Copy
With oNewWorkbook
.Worksheets(1).Range("A1").PasteSpecial xlPasteValues
Application.DisplayAlerts = False
' If you want to make the name dynamic to the date then do it like this
Dim DatedFileName As String ' I Broke it up this way so you can make the filename dynamic as well
DatedFileName = Format(Date, "yyyymmdd") & "_" & "SomeGenericName" & ".csv"
'Change this to your path with extension like
.SaveAs Filename:="C:\Users\yourpath\" & DatedFileName, FileFormat:=xlCSVUTF8, Local:=False
.Close
Application.DisplayAlerts = True
End With
End With
End If
Set rngTheRangeYouWant = Nothing
Set oNewWorkbook = Nothing
End Sub