Checking if exists before executing

[JasonBing]

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

 

[JasonBing]

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

 

[AlphaFrog]

[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]

 

[JasonBing]

Perfect. AlphaFrog, you are a dead set legend. Thank you very much. The job management team will be very happy