Checking if exists before executing

JasonBing

New Member
Joined
Aug 6, 2019
Messages
49
Hi there. I have the following code

Sub CreateJobCard()


Dim lastRow As Long
Dim thisRow As Long
Dim nextRow As Long
Dim sheetCount As Long
Dim selectedCells
Dim newSheet As Worksheet


On Error Resume Next


Application.ScreenUpdating = False


lastRow = Sheets("FTBJOB1").Cells(Sheets("FTBJOB1").Rows.Count, "A").End(xlUp).row
selectedCells = Application.Selection.Value


For sheetCount = 1 To UBound(selectedCells, 1)
Sheets("FTBJCT1").Copy After:=Sheets(Sheets.Count)
Set newSheet = Sheets(Sheets.Count)
newSheet.Name = selectedCells
nextRow = 46 'row select'
For thisRow = 2 To lastRow 'row select'
If Sheets("FTBJOB1").Cells(thisRow, "B").Value = selectedCells Then
Sheets("FTBJOB1").Cells(thisRow, "A").EntireRow.Copy Destination:=newSheet.Cells(nextRow, "A")
nextRow = nextRow + 1
End If
Next thisRow
Next sheetCount


Sheets("FTBJOB1").Activate
Range("A1").Select


Application.ScreenUpdating = True


End Sub



The user has a list of job numbers provided by customer, with a whole bunch of options in the cells adjacent. They select the job number cell then push a "create job card" button. This excites the above code.

The code creates a new sheet using the template sheet, named as per the active cell reference. Then it copes all the data from the row of the active cell and copies it to the new sheet with that name in row 46. The template sheet populates dependent on the data in the pasted row. Hope this makes sense.

What I would love is for the code to look FIRST look for a sheet with the name matching the active cell and if not found then execute. But if a sheet with this name is found, then pop up a message box saying "A Job Card Already Exists For This Job"

They can then use the search function to find the job card.

What would be the icing on the cake is for the message box to read

"A Job Card Already Exists For This Job, Would You Like To Open It" Then press ok and have them take them to the sheet, or cancel.

A lot to ask. But I am stumped.

Thanks for all the help. This forum has transformed our business.

JasonBing
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Just to add some detail, I need the code to end of course if a sheet is found with a name matching the active cell

Thanks
 
Upvote 0
Code:
[color=darkblue]Sub[/color] CreateJobCard()
    
    [color=darkblue]Dim[/color] lastRow   [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] thisRow   [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] nextRow   [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] sheetCount [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] selectedCells
    [color=darkblue]Dim[/color] newSheet  [color=darkblue]As[/color] Worksheet
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    lastRow = Sheets("FTBJOB1").Cells(Sheets("FTBJOB1").Rows.Count, "A").End(xlUp).Row
    s[B]electedCells = ActiveCell.Value[/B]
    
[B]    [color=darkblue]If[/color] [color=darkblue]Not[/color] Evaluate("ISREF('" & selectedCells & "'!A1)") Then      [color=green]'Test if worksheet name exists[/color][/B]
        Sheets("FTBJCT1").Copy After:=Sheets(Sheets.Count)
        [color=darkblue]Set[/color] newSheet = Sheets(Sheets.Count)
        newSheet.Name = selectedCells
        nextRow = 46    [color=green]'row select'[/color]
        [color=darkblue]For[/color] thisRow = 2 [color=darkblue]To[/color] lastRow    [color=green]'row select'[/color]
            [color=darkblue]If[/color] Sheets("FTBJOB1").Cells(thisRow, "B").Value = selectedCells [color=darkblue]Then[/color]
                Sheets("FTBJOB1").Cells(thisRow, "A").EntireRow.Copy Destination:=newSheet.Cells(nextRow, "A")
                nextRow = nextRow + 1
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] thisRow
    
        Sheets("FTBJOB1").Activate
        Range("A1").Select
[B]    [color=darkblue]Else[/color][/B]
[B]        [color=darkblue]If[/color] MsgBox("Would You Like To Open It?", vbOKCancel, "A Job Card Already Exists For This Job") = vbOK [color=darkblue]Then[/color][/B]
[B]            Application.Goto Sheets(selectedCells).Range("A1")[/B]
[B]        [color=darkblue]End[/color] [color=darkblue]If[/color][/B]
[B]    [color=darkblue]End[/color] [color=darkblue]If[/color][/B]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
Perfect. AlphaFrog, you are a dead set legend. Thank you very much. The job management team will be very happy
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

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