VBA routine throws up error if workbook is open

[Burrgogi]

This is a split off from my original thread here:

How to insert formula to show value and also account for instances of 2 digits versus 3 digits.

Sub Fanatical_Table() ' Workbooks.Open Filename:= _ "D:\Games\Game Collection\Fanatical Bundle Tracker Workbook (started on Nov 6, 2020).xlsm" Sheets.Add After:=Sheets(Sheets.Count), Type:= _ "D:\Games\Fanatical Bundle Template 2C.xltx" ActiveSheet.Name =...

www.mrexcel.com

I've got a VBA routine that works 99% perfectly. I have 2 small problems. First here's the code:

Sub Fanatical_Table()
'
    Workbooks.Open Filename:= _
        "D:\Games\Game Collection\Fanatical Bundle Tracker Workbook  (started on Nov 6, 2020).xlsm"
    Sheets.Add After:=Sheets(Sheets.Count), Type:= _
        "D:\Games\Fanatical Bundle Template 2C.xltx"
    ActiveSheet.Name = Format(Date, "mm_dd_yyyy")
    Range("A2").Select
    ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
    Columns("J:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    With Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row)
         .Formula = "(MID(C2,SEARCH("" "", C2)+1,SEARCH(""%"",C2,SEARCH(""%"", C2)-1)-SEARCH("" "", C2)-1)+0)/100"
         .Value = .Value
    End With
End Sub

1) Sometimes I have the workbook open and forget that's already open and when I try to run the macro, it throws up an error.
2) Sometimes there are 2 Fanatical bundle deals in one day. The macro works fine the first time I run it. Where I run into an issue is when I run it the 2nd time within the same day. That's because the macro names the first inserted worksheet with the current date like this: 09_21_22.

When I find the 2nd deal, I run the macro again. It runs into a error because obviously there's already a sheet named with the current date. This forces me to rename the previous sheet so I can run the macro again without errors. It would be nice to have the macro first check if there's an existing worksheet named as the current date. If so, then RENAME that worksheet something like this: 9_21_2022 (A). Then execute the remainder of the macro with the 2nd inserted sheet with this naming scheme: 9_21_2022 (B).

 

[breynolds0431]

Hi. Try this and note the function at the end.

Sub Fanatical_Table()

'set up workbook path and names in variables to easier change if needed
Dim wbPath As String: wbPath = "D:\Games\Game Collection\"
Dim wbName As String: wbName = "Fanatical Bundle Tracker Workbook  (started on Nov 6, 2020).xlsm"

'Checks if workbook is already open, exits if is after message
    Dim xRet As Boolean
    xRet = IsWorkBookOpen(wbName)
   
    If xRet Then
          MsgBox wbName & " is open on your computer. Close and retry action.", vbInformation, "Close and Retry"
          Exit Sub
    Else
       
    Workbooks.Open fileName:=wbPath & wbName

'checks if sheet name already exists
Dim ws As Worksheet, x As Long
x = 0

For Each ws In ActiveWorkbook.Worksheets
          If ws.Name = Format(Date, "mm_dd_yyyy") Then
                    x = x + 1
          End If
Next ws

If x > 0 Then
          'if sheet already exists, name new sheet with (B) and original sheet with (A)
          Sheets.Add After:=Sheets(Sheets.Count), Type:= _
                    "D:\Games\Fanatical Bundle Template 2C.xltx"
          ActiveSheet.Name = Format(Date, "mm_dd_yyyy") & "(B)"
          Sheets(Format(Date, "mm_dd_yyyy")).Name = Format(Date, "mm_dd_yyyy") & "(A)"
Else
          'if sheet doesn't already exist, name new sheet with today's date only
          Sheets.Add After:=Sheets(Sheets.Count), Type:= _
                    "D:\Games\Fanatical Bundle Template 2C.xltx"
          ActiveSheet.Name = Format(Date, "mm_dd_yyyy")
End If

    Range("A2").Select
    ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
    Columns("J:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    With Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row)
         .Formula = "(MID(C2,SEARCH("" "", C2)+1,SEARCH(""%"",C2,SEARCH(""%"", C2)-1)-SEARCH("" "", C2)-1)+0)/100"
         .Value = .Value
    End With
End Sub

Function IsWorkBookOpen(Name As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xWb Is Nothing)
End Function
End Function

 

[Burrgogi]

I get an error message when I run your code.
Compile error: Block End If without If

 

[breynolds0431]

I get an error message when I run your code.
Compile error: Block End If without If

Sorry about that. Right above the workbook open, replace the Else with End If

 

[Burrgogi]

Sorry about that. Right above the workbook open, replace the Else with End If

OK, made the change and now it works. I appreciate the help. By the way just a heads up....you have "End Function" typed twice at the end of your code. I caught that before I copied & pasted it to my VBA editor.