Macro breaks when run for the first time of the day when it adds another sheet to the file

Question

When I run my macro for the first time for the day it fails when it adds another sheet to the file.

Run-time error 1004: That name is already taken. Try a different
one.

My goal:

look for the file within \Downloads
convert the saved file it found from .xls -> .xlsx
delete the original downloaded file
run a bunch of formatting for printing.

When it fails, I close the current file, re-download the file, manually save the file with the needed format & name, delete the download, re-download the file.
After that I can run the macro.

The line that breaks: Sheets.Add(After:=Sheets("Dock Activity Report")).Name = "Cases"

Sub Schedule_macro()

    Dim Filename, Pathname, SaveFileName As String
    Dim wb As Workbook
    Dim UserName As String

    UserName = Environ("username")
    Pathname = "C:\Users\" & Environ$("username") & "\Downloads\"
    Filename = Dir(Pathname & "Dock_Activity_*.xls")
    SaveFileName = Dir(Pathname & "dockactivity.xlsx")
    
    Application.DisplayAlerts = False
    If Len(Dir(Pathname & "Dock_Activity_*.xls")) > 0 Then
        Debug.Print "Filename found, running macro"
    Else
        MsgBox "You need to download the" & vbNewLine & "Dock Activity Report from the" & vbNewLine & "'Report Run Log' in Lean." & vbNewLine & vbNewLine & "Once downloaded, please rerun the macro", vbCritical, "HiRise Schedule Macro"
        Debug.Print "could not find Filename within given Pathname"
        Debug.Print "exiting macro"
        Exit Sub
    End If
  
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        wb.CheckCompatibility = True
    
        Application.DisplayAlerts = False
        wb.SaveAs Filename:="dockactivity", FileFormat:=xlOpenXMLWorkbook
        wb.Close SaveChanges:=False
    
        Filename = Dir(Pathname & "Dock_Activity_*.xls")
        Filename = Dir()
    Loop

    Application.DisplayAlerts = True
    
    If Dir(Pathname & "Dock_Activity_*.xls") <> "" Then
        kill (Pathname & "Dock_Activity_*.xls")
    End If

    Debug.Print "looking for SaveFileName within given Pathname"
    Set wb = Workbooks.Open(Pathname & "dockactivity.xlsx")
    Debug.Print "SaveFileName found, opening file"

    Windows("dockactivity.xlsx").Activate
    Rows("1:21").Delete Shift:=xlUp
    Range("A:B,D:F,H:N,S:S,U:V,X:Y,AB:AK,AM:BA").Delete Shift:=xlToLeft
    Columns("H:H").Cut
    Columns("A:A").Insert Shift:=xlToRight
    Columns("K:K").Cut
    Columns("G:G").Insert Shift:=xlToRight
    Columns("J:K").Copy
    Range("L1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("J:K").ClearContents
    Range("J1").FormulaR1C1 = "Trailer Number"
    Range("K1").FormulaR1C1 = "Arrival Time"
    Columns("G:M").Copy
    Range("N1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("N1").FormulaR1C1 = "Door"
    Range("O1").FormulaR1C1 = "Ship Rail"
    Range("P1").FormulaR1C1 = "Staged"
    Range("Q1").FormulaR1C1 = "Check If Loaded"
    Range("R1").FormulaR1C1 = "Case Picks"
    Range("S1").FormulaR1C1 = "Layer Picks"
    Range("T1").FormulaR1C1 = "Check if Released by Pool"
    Debug.Print "1:1 table headers complete"
    Columns("A:B").ColumnWidth = 17.71
    Columns("C:C").ColumnWidth = 19.14
    Columns("D:D").ColumnWidth = 25.71
    Columns("E:E").ColumnWidth = 14.41
    Columns("F:F").ColumnWidth = 10.71
    Columns("G:G").ColumnWidth = 30.29
    Columns("H:H").ColumnWidth = 9.43
    Columns("I:I").ColumnWidth = 13.71
    Columns("J:J").ColumnWidth = 26.14
    Columns("K:L").ColumnWidth = 23.57
    Columns("M:M").ColumnWidth = 46
    Columns("N:S").ColumnWidth = 15
    Columns("T:T").ColumnWidth = 12.86
    Debug.Print "column resizing complete"
    Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Rows("1:1").RowHeight = 75
    Rows("2:150").RowHeight = 55
' #############################################################################    
    Sheets.Add(After:=Sheets("Dock Activity Report")).Name = "Cases"
    Sheets.Add(After:=Sheets("Cases")).Name = "Layers"
' #############################################################################    
    Sheets("Dock Activity Report").Range("R2:R150").FormulaR1C1 = "=VLOOKUP(RC[-17],Cases!C[-13]:C[-12],2,FALSE)"
    Sheets("Dock Activity Report").Range("S2:S150").FormulaR1C1 = "=VLOOKUP(RC[-18],Layers!C[-15]:C[-14],2,FALSE)"
    Worksheets("Dock Activity Report").Select
    Range("A2:T150").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$C2=""Live Trailer"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With

    Range("B2:B150").Select
    ActiveWorkbook.Worksheets("Dock Activity Report").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Dock Activity Report").Sort.SortFields.Add Key:= _
        Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Dock Activity Report").Sort
        .SetRange Range("A1:T150")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveWorkbook.Worksheets("Dock Activity Report").Select
    Columns("A:A").Copy
    Columns("B:B").Insert Shift:=xlToRight
    Range("B2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=IFERROR(RC[-1]*1,TRIM(RC[-1]))"
    Range("B3").Select
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B150"), Type:=xlFillDefault
    Range("B2:B150").Select
    Columns("B:B").Copy
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Debug.Print "A:A value reformat complete"
    Sheets("Dock Activity Report").Select
    Columns("A:T").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=COUNTA($A1:$F1)>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Debug.Print "cell borders added"
    
    Dim r As Long
    Dim LastRow As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For r = LastRow To 1 Step -1
        If Cells(r, 1) = 0 Then
            Rows(r).Delete
        End If
    Next r
    Range("A1").Select
    
    Sheets("Cases").Range("E2:E300").FormulaR1C1 = "=VALUE(TRIM(CLEAN(RC[-4])))"
    Sheets("Cases").Range("F2:F300").FormulaR1C1 = "=RC[-2]"
    Sheets("Cases").Columns("E:F").EntireColumn.Hidden = True
    Sheets("Layers").Range("D2:D300").FormulaR1C1 = "=VALUE(TRIM(CLEAN(RC[-3])))"
    Sheets("Layers").Range("E2:E300").FormulaR1C1 = "=RC[-2]"
    Sheets("Layers").Columns("D:E").EntireColumn.Hidden = True
    Sheets("Dock Activity Report").Range("A1").Select
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = True
    MsgBox "All Finished!", vbInformation, "HiRise Schedule"
    ActiveWorkbook.Save
End Sub

score 0 · Answer 1 · answered Dec 19 '19 at 08:19

0

That is because there is already a sheet with that name.

Add this code and it will be ok.

On Error Resume Next
Application.DisplayAlerts = False
Sheets("Cases").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Sheets.Add(After:=Sheets("Dock Activity Report")).Name = "Cases"

TIP: Avoid the use of .Select/Activate. Work with Objects. You may want to see How to avoid using Select in Excel VBA. It will be easy to manage the code as well.

answered Dec 19 '19 at 08:19

Siddharth Rout

147,039
17
206
250

Will I need to do this twice? Once for "Cases" and once for "Layers"? – Colvin Dec 19 '19 at 08:30
Whenever you add a new sheet and name it, it is a good practice to check if that sheet exists **OR** simply delete it (whicever is convenient to you) – Siddharth Rout Dec 19 '19 at 08:31
Why does the sheet still exist if I overwrite the save before it's opened? – Colvin Dec 19 '19 at 08:34
Are you referring to `wb.SaveAs Filename:="dockactivity", FileFormat:=xlOpenXMLWorkbook` ? – Siddharth Rout Dec 19 '19 at 08:37
So open that file and check for hidden sheets. It is possible there is a hidden sheet with that name? – Siddharth Rout Dec 19 '19 at 08:47
Not that I am able to find. The macro is ran daily but only fails when it is being ran for the first time of the day. After that, no issues – Colvin Dec 19 '19 at 08:55
ok first things first. did you try as i suggested? using that code. did it work? – Siddharth Rout Dec 19 '19 at 08:58
I added it, I won't be able to tell until tomorrow though since I've already ran this today. – Colvin Dec 19 '19 at 08:59

Macro breaks when run for the first time of the day when it adds another sheet to the file

1 Answers1