Save XLSM and CSV at same time

[Dazzawm]

Is it possible that when I close a macro enabled workbook to one location it can be saved as a CSV in a different location at the sametime?

 

[Trevor G]

I would say yes, you would have to look at the workbook options in the VBA screen and add some code to Before Save or After Save.

In the VBA Screen (use Alt + F11) double click on the project window where it states ThisWorkBook then change the drop down from Object to Workbook and on the right change the procedure to BeforeSave or AfterSave. I asssume you would Save as A copy for the CSV file before or After Saving the Workbook.

Or do you want to use a Macro in a modlue sheet to give you a button or something to save as both?

 

[Dazzawm]

I dont really understand what you mean but at the moment I have 20 different workbooks that perform certain actions via code before they close and are saved as XLSM. I need some code to save also as CSV to a different location at the same time.

 

[Trevor G]

Who created your code that you run?

Try recording a macro to use the Save As and then select CSV and give a name and select a location.

Then in the same Macro do the same for the Macro Saved Workbook it will then give you the code you need to add to your current code.....

 

[Dazzawm]

Its some code that has been written for me and some I have recorded and added in. I have tried as you suggested but it doesnt work properly because it looks like in conflicts with some code already.

 

[Trevor G]

OK add your code to your thread and state the workbook name you want to use and CSV file name you want to use as well.

If we get one working then you can adapt it.

 

[Dazzawm]

The output names will be the same, and this code below works for all the files as I dont think they are workbook name specific.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveSheet.Name = "Sheet1"
Sheets("Sheet1").Range("H" & Rows.Count).End(xlUp).Value = Date
Dim lr As Long
lr = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Range("A2:A3").AutoFill Destination:=Range("A2:A" & lr)
Dim ws As Worksheet
    Dim d As Object, colData As String, colOut As String
    Dim x&, zr&, k, e, t!
    
    t = Timer
    
    Set ws = ActiveSheet    '
    colData = "C"           'Column of data to count
    colOut = "D"            'Output column for running count
    
    Set d = CreateObject("scripting.dictionary")
    zr = ws.Cells(Rows.Count, colData).End(xlUp).Row
    e = ws.Range(ws.Cells(2, colData), ws.Cells(zr, colData))
    ReDim k(1 To UBound(e, 1), 1 To 1)
    For x = LBound(e, 1) To UBound(e, 1)
        If d.exists(e(x, 1)) Then
            d(e(x, 1)) = d(e(x, 1)) + 1
            k(x, 1) = d(e(x, 1))
        Else
            d(e(x, 1)) = 1
            k(x, 1) = 1
        End If
    Next x
    
    ws.Range(ws.Cells(2, colOut), ws.Cells(zr, colOut)) = k
    'MsgBox Format(Timer - t, "0.00 secs"), , "Process Time"
Cells.Select
Cells.EntireColumn.AutoFit
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
Range("A1").Select
End Sub