Anyone see why this VBA isn't working as intended?

sanantonio

Board Regular
Joined
Oct 26, 2021
Messages
124
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
Sub save()

Dim fName As String
Dim path As String
Dim defaultPath As String

defaultPath = "T:\"
   path = Sheet1.Range("D18").Value
   If path = "" Then
        path = defaultPath
    End If
   If Right(path, 1) <> "\" Then
        path = path & "\"
    End If

fName = Range("A1")
Application.DisplayAlerts = False
On Error Resume Next
     Sheets("CSV").Visible = True
Sheets("CSV").Select
    Range("B34").Select
    Sheets("Order Upload DIS").Select
    Range("Table3[Copy all lines as of A3]").Select
    Selection.Copy
    Sheets("CSV").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Dim theNewWorkbook As Workbook
Dim currentWorkbook As Workbook

Application.EnableEvents = False



'currentWorkbook is the source workbook, create a new workbook referencing to it with theNewWorkbook
Set currentWorkbook = ActiveWorkbook
Set theNewWorkbook = Workbooks.Add

'do the copy (it's better to check if there is already a 'Worksheet 1' in the new workbook. It it exists delete it or rename it
currentWorkbook.Worksheets("CSV").Copy before:=theNewWorkbook.Sheets(1)

'Remove default sheets in order to have only the copied sheet inside the new workbook
Dim i As Integer
For i = theNewWorkbook.Sheets.Count To 2 Step -1
    theNewWorkbook.Sheets(i).Delete
Next i
'Save File as XLSM
saveLocation = defaultPath & fName & ".csv"
theNewWorkbook.SaveAs Filename:=saveLocation, FileFormat:=xlCSV
theNewWorkbook.Close
     Sheets("CSV").Visible = False
     Sheets("Control").Select
     MsgBox saveLocation
End Sub

Basically it should only be saving to the defaultPath is D18 is blank. But regardless of whether D18 is blank or not it always saves to the default. Anyone see where I'm going wrong?

D18 contains: K:\New Folder\Testing\
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
According to the code, you are supposed to use the path variable instead of defaultPath for the saveLocation variable assignment.

VBA Code:
saveLocation = path & fName & ".csv"
 
Upvote 1
Solution
I couldn't see the wood for the trees! Thank you!
It happens to all :)
Glad to hear it is solved.

If you don't mind, I would suggest a couple of things for the existing code.

The following section:
VBA Code:
Application.DisplayAlerts = False
On Error Resume Next
     Sheets("CSV").Visible = True
Sheets("CSV").Select
    Range("B34").Select
    Sheets("Order Upload DIS").Select
    Range("Table3[Copy all lines as of A3]").Select
    Selection.Copy
    Sheets("CSV").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Could be replaced with the following. Instead of selecting, copying, and pasting, we can simply transfer the table column cell values as shown below.
VBA Code:
   Dim rng As Range
    ThisWorkbook.Worksheets("CSV").Visible = True
    Set rng = ThisWorkbook.Worksheets("Order Upload DIS").Range("Table3[Copy all lines as of A3]")
    ThisWorkbook.Worksheets("CSV").Range("A1").Resize(rng.Rows.Count).Value = rng.Value

I like how you delete the unnecessary worksheets from the new workbook starting from the last worksheet. I would only disable and enable alerts to avoid the deletion confirmation message. The current code already does the disabling part but it is better to disable the alerts right before the worksheet deletion and enabling back right after the deletion is completed.
VBA Code:
        'Remove default sheets in order to have only the copied sheet inside the new workbook
        Application.DisplayAlerts = False
        For i = theNewWorkbook.Worksheets.Count To 2 Step -1
            theNewWorkbook.Worksheets(i).Delete
        Next i
        Application.DisplayAlerts = True

And, I wouldn't use "On Error Resume Next" since the current structure doesn't look like that it needs error handlers.
 
Upvote 0
Super helpful thank you, I'll take a look at what I can trim next time I've some optimization time on the calendar!
 
Upvote 0

Forum statistics

Threads
1,214,553
Messages
6,120,176
Members
448,948
Latest member
spamiki

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