Macro to prep a CSV file - data selection, manipulation, and saving with dynamic name

Spiritseeker

New Member
Joined
Feb 20, 2009
Messages
38
Hi all,

I am a VBA novice; I spent many hours today watching Wise Owl tutorials (which I highly recommend), but need a working macro soon, and must concede that I think this is a bit beyond my beginner status. I've tried to lay out my requirements in a way that I think explains what I need, based on the tutorials I watched, and would be very grateful for help in coming up with this macro.

Up front info about what I am trying to do:

I need a macro to prep a file for csv upload which will contain rows with an identifier ("H" for header or "L" for line) in column A.
H rows will contain data from column A to AA and L rows will contain data from column A to I only

Every cell from column A to AE contains a formula, down to row 40. The user can add rows by copying down the formulas, and if they do this will likely end up doing so for more rows than actually needed. The user may input data on 2 rows, or 2000 rows etc - it's as needed.

I would like to include a Macro button on row 1 (users are basic excel users – no Macro knowledge, hence the button to click to run the macro), which is a row that will be deleted as part of the macro – will that cause a problem?

The data to end up in the final CSV file to be uploaded will be a dataset which overall has data in columns A to AA, for all rows with an H or an L in column A. Because the L rows only contain data from column A to I, but the overall dataset goes to column AA, my test files show that the csv file has commas on the rows with L in column A representing blank cells from columns J to AA. These need to be deleted prior to saving the CSV, as the upload process will not accept them and expects the L rows to finish at column I.

The macro enabled sheet will be password protected to be read only, to ensure that it isn’t accidentally saved over by the user.

What I need the Macro to actually do:

1 Delete all tabs apart from sheet1 (will be renamed as AccrualOffer in VBA properties – would like to remove the warning message so the user does not have to select that they are sure they want to delete the tabs)
2 Highlight selection from A4 to last row containing an H or an L , across to column AA (I think this may be: Range("A4", Selection.End(xlDown)).Select Range(Selection, Selection.Offset(0, 26)).Select)
3 Clean any trailing spaces in the cells in the selection
3 Copy selection
4 Hard paste into same place (most data will be formula driven prior to this step)
5 Drop down 1 row and delete next 300 rows (idea is to delete 300 rows of data below the selected area in case the user has put in any data anywhere such as a quick calculation formula, or copied down the formulas on rows that didn’t get used – ie rows without an L or H in column A)
6 Delete rows 1 to 3 (these contained instructions, and the Macro button itself unless this will cause a problem)
7 Delete columns AB:AP (these were columns containing info for formulas in the other columns, and cannot form part of the final file)
8 Delete cells in columns J to AA on rows where column A contains an L (see note in info above to see why – it’s because the L (Line) rows only contain data to column I, and without this step, the csv file would save them as a cell with no data and try to upload it, and it would fail)
9 Open Save as window, with CSV file type with name as follows based on Excel syntax to try to demonstrate what I mean: “ozfaoffer_”&”OffernameFromCellB1”&”V1” so the middle section of the file name will be taken from cell B1 after all the data has been manipulated in the prior steps – but don’t save at this point if possible, I’d like the user to be able to edit the file name at this point in case they have to update it to end with v2, or v3 etc instead of v1 (failed upload attempts due to incorrect data in the csv load ‘utilise’ a file name, so a subsequent file name cannot be the same).

If anyone needs further info, please let me know.

Many thanks in advance for the help
 
Last edited:
how about try this, i updated some of the code if the path doesn't exist will display a dialog to get the path.

Code:
Public Sub Export_To_CSV()
Dim lLastRow As Long
Dim r As Integer
Dim c As Integer


Dim strRowValue As String
Dim bDirExists As Boolean
Dim oFSO As Object


Dim iFile As Integer
Dim cfile As String
Dim cPath As String
Dim fDialog As FileDialog


Set oFSO = CreateObject("Scripting.FileSystemObject")
With ThisWorkbook.Sheets("Sheet1")
    lLastRow = .Range("A" & .Rows.Count).End(xlUp).Row ' get the last row in column a
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    cPath = "\\ukdsdfsdf\Sales\SOA and PP documentation\Oracle uploads" ' file path
    bDirExists = oFSO.folderExists(cPath) ' check to make sure the path exists
    If bDirExists = False Then
        With fDialog
            .Title = "Select a folder"
            .AllowMultiSelect = False
            .Show
            If Not .SelectedItems.Count = 0 Then
                cPath = .SelectedItems(1) ' if the path does not exist then display a dialog to get path
            Else
                MsgBox "No path selected": Exit Sub
            End If
        End With
    End If
    
    cfile = cPath & "\" & "ozfaoffer_" & .Range("B1").Value & "_" & Format(Now(), "mmddyyyy_hhnnss") & ".csv"
    
    iFile = FreeFile()
    Open cfile For Output As #iFile ' open the text file in the path and name specified


    For r = 4 To lLastRow ' loop through the rows
        strRowValue = ""
        Select Case Cells(r, 1).Value ' check the row and cell for a H or L
            Case "H" 'if the cell is an H then loop through that row Cells A through AA
                 For i = 1 To 27
                    strRowValue = strRowValue & Trim(.Cells(r, i).Value) & "," ' use the cell's value and remove any trailing spaces
                 Next i
            Case "L" 'if the cell is an L then loop through that row Cells A through I
                For i = 1 To 9
                    strRowValue = strRowValue & Trim(.Cells(r, i).Value) & "," ' use the cell's value and remove any trailing spaces
                Next i


                           
        End Select
        strRowValue = Trim(Left(strRowValue, Len(strRowValue) - 1)) ' remove the trailing ","
        Print #iFile, strRowValue ' add the comma delimited data to the file
    Next r  ' loop to the next row




Close #iFile   ' close the file


End With
InputBox "File Created:", "Export to CSV successful!", cfile ' using a input box so user can copy the file path and name.
'MsgBox "Export to csv successful!" & Chr(10) & "File created:" & cfile


End Sub
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
I appreciate you plugging away!

This time, the Save box pops up but it's not quite a 'normal' save window. Instead of asking me to input a file name to save the file, it's asking me to input a Folder name. There is no file name or file type pre populated, and it is trying to save to my desktop (where I last saved a file).
If I click cancel, I get a warning message pop up saying "no path selected".

I tried updating the folder path to my desktop again to eliminate any issues with saving to a server location but I got the same issue as earlier - the file doesn't exist.

I tried to revert the macro back to getting the 'choose path location' pop up but it's no longer coming up - I am getting the same error that the file doesn't exist, so I really am not understanding the issue here.
 
Upvote 0
Ok, to test whether it's a server issue, I updated the macro to save it to my desktop.
It didn't give me the pop up window to select a path, but it's still this line of code where it says the file does not exist:

Code:
Open cfile For Output As #iFile ' open the text file in the path and name specified

I tried putting in a path that does not exist, and it did pop up the window asking me to select a path. So this tells me that the folder location is not an issue - even on the server.
It just isn't saving the file for whatever reason?
 
Last edited:
Upvote 0
I found the issue!!!!

The reference to cell B1 in the file name. I confused you - the data in B1 to use in the file name, would only be in that cell if you had first deleted rows 1 to 3 as I initially thought would be done as part of the macro as per my numbered step approach.

I took this part out of the file name, and it saved, thankfully!! I was going slightly crazy trying to work this out!

And the file formatting looks great. Thank you so, so much for your patience!
 
Upvote 0
So this is the way that you is the other way of doing it, the way that you asked.
except it will prompt for the location to save the file each time.
does the manipulation of the excel file and save as to the location as csv.

Code:
Public Sub Export_To_CSV2()
Dim lLastRow As Long
Dim r As Integer
Dim c As Integer




Dim cfile As String
Dim cPath As String
Dim fDialog As FileDialog
Dim sFileName As String


Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'set the worksheet to sheet 1


    ws.Range(ws.Cells(1, 1), ws.Cells(ws.Rows.Count, ws.Columns.Count)).Copy ' copy all
    ws.Range(ws.Cells(1, 1), ws.Cells(ws.Rows.Count, ws.Columns.Count)).PasteSpecial xlValues ' paste as values


    sFileName = ws.Range("B1") ' set inital file name to the value in b1
    For Each Sheet In ThisWorkbook.Worksheets ' loop through sheets and delete all except sheet1
        
        If Sheet.Name <> "Sheet1" Then Application.DisplayAlerts = False: Sheet.Delete: Application.DisplayAlerts = False
    Next
    ThisWorkbook.Worksheets("Sheet1").Name = "AccrualOffer"
    ws.Rows("1:3").EntireRow.Delete xlUp ' delete the first 3 rows
        
    lLastRow = Range("A" & ws.Rows.Count).End(xlUp).Row ' last used row in column a


    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker) 'get path to save file
        With fDialog
            .Title = "Select a folder"
            .AllowMultiSelect = False
            .Show
            If Not .SelectedItems.Count = 0 Then
                cPath = .SelectedItems(1) ' if the path does not exist then display a dialog to get path
            Else
                MsgBox "No path selected": Exit Sub
            End If
        End With
    
    cfile = cPath & "\" & "ozfaoffer_" & sFileName & "_V" & Format(Now(), "mmddyyyy_hhnnss") & ".csv"
    Debug.Print "A" & lLastRow + 1 & ":A" & ws.Rows.Count
    ws.Range("A" & lLastRow + 1 & ":A" & ws.Rows.Count).EntireRow.Delete xlUp
    


    For r = 1 To lLastRow ' loop through the rows
        Select Case Cells(r, 1).Value ' check the row and cell for a H or L
            Case "H"
                 
                 ws.Range(ws.Cells(r, 28).Address, ws.Cells(r, ws.Columns.Count)).Delete xlToLeft ' delete the extra columns
                    For c = 1 To 27
                        ws.Cells(r, c).Value = Trim(ws.Cells(r, c).Value) ' remove trailing spaces
                    Next c
            Case "L"
                ws.Range(ws.Cells(r, 10).Address, ws.Cells(r, ws.Columns.Count)).Delete xlToLeft ' delete the extra columns
                    For c = 1 To 9
                        ws.Cells(r, c).Value = Trim(ws.Cells(r, c).Value) ' remove trailing spaces
                    Next c
        End Select
    Next r  ' loop to the next row




ThisWorkbook.SaveAs cfile, xlCSV




InputBox "File Created:", "Export to CSV successful!", cfile ' using a input box so user can copy the file path and name.
'MsgBox "Export to csv successful!" & Chr(10) & "File created:" & cfile


End Sub
 
Upvote 0

Forum statistics

Threads
1,215,444
Messages
6,124,891
Members
449,194
Latest member
JayEggleton

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top