Simple Export to CSV - SOLVED

[somebody113]

Hey Guys,

I have a file in the following path:

C:\Users\k\Desktop\TLOU\POF.xlsx

There are values in Sheet2 that I would like to export to .csv using a macro

I should be able to specify the:

1. Directory to where I am exporting to
2. The range of cells that I want to export in Sheet 2

[JBeaucaire]

...and the CSV filename?

[JBeaucaire]

This will save the CSV to the chosen path with the name POF-40397.13245.csv where the two sets of numbers are date/time stamps in raw format so they will always sort correctly. Also, this means you could save over and over again and never get duplication errors.

Option Explicit

Sub ExportSelectionToCSV()
Dim fPath As String

If Selection.Cells.Count = 1 Then
    MsgBox "Please select the full range of cells to save as CSV"
    Exit Sub
End If

'Folder selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        .Show
        If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\" Else Exit Sub
    End With

Application.ScreenUpdating = False
Selection.Copy
Sheets.Add
Range("A1").PasteSpecial
ActiveSheet.Move

ActiveWorkbook.SaveAs Filename:=fPath & "POF" & "-" & Format(Now(), "0.00000") & ".csv", _
                    FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

[JBeaucaire]

Crossposted: http://www.mrexcel.com/forum/showthread.php?t=574890

[somebody113]

Hey JBeau,

Thanks for the help! Just a few quick questions....

1. I need the name of the file to be static and not changing, so the altered code would be:

ActiveWorkbook.SaveAs Filename:=fPath & "POF"  & ".csv", _
                    FileFormat:=xlCSV, CreateBackup:=False

Right?

2. I'm assuming the .csv file is outputted in the same directory as the original excel file right?


3. Also.... it appears that it's using the cell ranges from the Active sheet, I'll be using data from another sheet called "output", how can I specify that?

[JBeaucaire]

1) I misread your "source" as being the cells you had "selected". You want the Sheet/range to be static, but definable. That's changed in the code below to the flat name requested, it's even simpler.

2) Why assume that? You requested the macro allow you to choose the output folder each time? Is that wrong, too? When you try the macro below, it will prompt you to select a destination folder. I thought that's what you asked for.

3) I've changed the "selection" process in the macro below to a specified range.

Option Explicit

Sub ExportToCSV()
Dim fPath As String

'Folder selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        .Show
        If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\" Else Exit Sub
    End With

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Output").Range("A1:Z100").Copy    'edit this range as needed
Sheets.Add
Range("A1").PasteSpecial
ActiveSheet.Move

ActiveWorkbook.SaveAs Filename:=fPath & "POF.csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

If you really don't want to choose a folder each time, but that's the same all the time, too, then use this, even simpler:

Option Explicit

Sub ExportToCSV()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Output").Range("A1:Z100").Copy    'edit this range as needed
Sheets.Add
Range("A1").PasteSpecial
ActiveSheet.Move

ActiveWorkbook.SaveAs Filename:="C:\OutputDir\CSV\POF.csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

[somebody113]

Hey Jbeau!

You are an absolute genius! I've been using this below:

Option Explicit

Option Explicit

Sub Images1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("a1Output").Range("E5:J304").Copy    'edit this range as needed
Sheets.Add
Range("A1").PasteSpecial
ActiveSheet.Move

ActiveWorkbook.SaveAs Filename:="C:\Users\k\Dropbox\d1.csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

and it's been working perfectly, I'm just curious about this line below:

Sheets("a1Output").Range("E5:J304").Copy    'edit this range as needed

I have about 300 rows of data there, it doesn't always fill all the rows so if there are empty rows it just throws extra commas in the csv file like:

,,,,

because they're empty rows, is there a way I can tell excel to not include the empty rows when exporting this csv? Thanks again!

[JBeaucaire]

Option Explicit

Sub Images1()
Dim LR as Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    With Sheets("a1Output")
        LR = .Range("E" & .Rows.Count).End(xlUp).Row
        .Range("E5:J" & LR).Copy    'edit this range as needed
    End With
    
    Sheets.Add
    Range("A1").PasteSpecial
    ActiveSheet.Move
    
    ActiveWorkbook.SaveAs Filename:="C:\Users\k\Dropbox\d1.csv", FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

[somebody113]

Hey Jbeau,

Gave that one a shot, it's still populating the empty rows, I think it's doing it because even though those rows are empty, there are formulas in there.

Since the file location doesn't change, perhaps there is a macro that can go into the csv file afterwards and delete the empty rows?

Thanks!

[JBeaucaire]

Nah, we can fix that by changing the way we find the "Last Row". Change this:

LR = .Range("E" & .Rows.Count).End(xlUp).Row

...to this

LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

As long as those formulas that result in blank values result in NULL values, this should skip up to the last visible value.

[somebody113]

Dang, I don't know what I'm doing wrong here =(

Could you take a look at this workbook? I uploaded to my ftp. Macro is in module 3

www.jyxsaw.com/wagm/POF%20DEM.xlsm

[JBeaucaire]

From now on, post your workbook first, save us all the guess work.

The LR construct is now looking for the last row with visible data, we mentioned that already. That includes your column A numbers. Oops.

Change the formula in A6 to:

=IF(B6="", "", A5+1)

...and copy down, that will cause the blank rows to be blank in column A, too. Make that change on all your sheets with codes going down column A.

Also, the macro currently in the workbook is the original macro from post #7. Why is that? We've made multiple changes since them, did you try them at all? Disappointing to see the macro in use isn't close the one you're supposed to be trying.

Anyway, another tweak to the LR method, this should work IF you make the formula change to column A noted above.

Option Explicit

Sub Images1()
Dim LR As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    With Sheets("a1Output")
        LR = .Range("A:A").Find(WorksheetFunction.Max(.Range("A:A")), LookIn:=xlValues, LookAt:=xlWhole).Row
        .Range("E5:J" & LR).Copy    'edit this range as needed
    End With
    
    Sheets.Add
    Range("A1").PasteSpecial
    ActiveSheet.Move
    
    ActiveWorkbook.SaveAs Filename:="C:\Users\k\Dropbox\d1.csv", FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

[somebody113]

Hey Jbeau,

Sorry, I forgot to save it when I uploaded it, it works now!!! =)

For anyone curious, here's the final sheet:

www.jyxsaw.com/wagm/POF%20DEM.xlsm

[JBeaucaire]

If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.

[snb]

did you consider:

 
Sub Images1()
  with Application
    .ScreenUpdating = False
    .DisplayAlerts = False
  end with

  with getobject("C:\Users\k\Desktop\TLOU\POF.xlsx")
    .sheets("a1Output").copy
    .close false
  end with

  with activeworkbook
    .sheets(1).rows(1).resize(4).delete
    .SaveAs "C:\Users\k\Dropbox\d1.csv", xlCSV    
    .Close False
  end with
End Sub

[somebody113]

Hey Jbeau,

Regarding the final macro:

Option Explicit

Sub Images1()
Dim LR As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

 With Sheets("broad")
        LR = .Range("A:A").Find(WorksheetFunction.Max(.Range("A:A")), LookIn:=xlValues, LookAt:=xlWhole).Row
        .Range("A1:A" & LR).Copy    'edit this range as needed
    End With
    
    Sheets.Add
    Range("A1").PasteSpecial
    ActiveSheet.Move
    
    ActiveWorkbook.SaveAs Filename:="C:\Users\k\Dropbox\d1.csv", FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

When I use the following Formula with the macro:

=IF($B5="","",VLOOKUP($B5,Copy!$A$7:$B$21,COLUMNS(Copy!$A$7:$B$21),FALSE))

it works just fine, but if I use something simpler like:

=IF(Sheet1!A14="", "", Sheet1!A14)

it doesn't work

I was just curious for an explanation, the following macro isn't working correctly on this sheet



I've attached the orig file to my FTP

http://www.jyxsaw.com/ZCOU/ACdem.xlsm

[somebody113]

sry, double post

[JBeaucaire]

I don't see the edited macro you're attempting to use anywhere in the workbook.

"doesn't work" is a remarkably incomplete explanation.