Checking to see if value exists before proceeding?

[jmpatrick]

Good afternoon!

I have a macro that populates data from a UserForm to an intermediate sheet (called JobGrid) then creates a new row on the main sheet (called Calendar). It then copies the data from JobGrid to the new row on the main sheet.

Works great. What I now need is to scan a range on the Calendar sheet (called SubLotColumn) before adding the job to see if it already exists. If it exists you'd get a message box saying so and the Sub ends. If it doesn't exist it goes ahead (starting at 'Insert Blank Row).

Here's my fabulous (probably over-engineered) code:

Sub SubmitJob()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Dim sh As Worksheet
    Dim iRow As Long
   
    'Populate JobGrid
    Set sh = ThisWorkbook.Sheets("JobGrid")
   
    With sh
          
        .Cells(1) = frmForm.ShippingDate.Value
       
        .Cells(2) = frmForm.SubCode.Value
       
        .Cells(3) = frmForm.SubName.Value
       
        .Cells(4) = frmForm.LotNumber.Value
                     
        .Cells(5) = frmForm.Models.Value
       
        .Cells(6) = frmForm.Elevation.Value
       
        .Cells(7) = frmForm.GarageHandling.Value
               
        .Cells(10) = Application.UserName
       
        .Cells(11) = [Text(Now(), "MM/DD/YYYY HH:MM:SS AM/PM")]
   
    End With

    'Insert Blank Row
    Sheets("Calendar").Select
    ActiveSheet.Unprotect
    Sheets("Template").Visible = True
    Sheets("Template").Select
    Rows("5:5").Select
    Selection.Copy
    Sheets("Calendar").Select
    Rows("10:10").Select
    Selection.Insert Shift:=xlDown
    Rows(ActiveCell.Row).Select

    'Copy Shipping Date
    Sheets("JobGrid").Visible = True
    Sheets("JobGrid").Select
    Range("A1").Select
    Selection.Copy
    Sheets("Calendar").Select
    Range("B10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    'Copy Subdivision/Lot Number
    Sheets("JobGrid").Select
    Range("I1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calendar").Select
    Range("C10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
              
    'Copy Model
    Sheets("JobGrid").Select
    Range("E1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calendar").Select
    Range("F10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    'Copy Elevation
    Sheets("JobGrid").Select
    Range("F1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calendar").Select
    Range("G10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    'Copy Garage Handling
    Sheets("JobGrid").Select
    Range("G1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calendar").Select
    Range("H10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    'Copy Added By
    Sheets("JobGrid").Select
    Range("J1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calendar").Select
    Range("BQ10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    'Copy Date/Time Added
    Sheets("JobGrid").Select
    Range("K1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calendar").Select
    Range("BR10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
                      
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
End Sub

 

[NoSparks]

When copying and pasting values only, you don't actually need to use copy and paste, you can just make one range equal to the other, for example,
this

 'Copy Shipping Date
    Sheets("JobGrid").Visible = True
    Sheets("JobGrid").Select
    Range("A1").Select
    Selection.Copy
    Sheets("Calendar").Select
    Range("B10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

can be reduced to

'Copy Shipping Date
Sheets("Calendar").Range("B10") = Sheets("JobGrid").Range("A1")

Maybe you can work with something along the lines of

Sub SubmitJob()

Dim sh As Worksheet
Dim fndJob As Range, job As String
    
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
'Populate JobGrid
Set sh = ThisWorkbook.Sheets("JobGrid")
With sh
    .Cells(1) = frmForm.ShippingDate.Value                      'A1 gets copied
    .Cells(2) = frmForm.SubCode.Value                           'B1 not
    .Cells(3) = frmForm.SubName.Value                           'C1 not
    .Cells(4) = frmForm.LotNumber.Value                         'D1 not
    .Cells(5) = frmForm.Models.Value                            'E1 gets copied
    .Cells(6) = frmForm.Elevation.Value                         'F1 gets copied
    .Cells(7) = frmForm.GarageHandling.Value                    'G1 gets copied
    'nothing into H and I ' presumably uses whats copied in from Template ?????
    .Cells(10) = Application.UserName                           'J1 gets copied
    .Cells(11) = [Text(Now(), "MM/DD/YYYY HH:MM:SS AM/PM")]     'K1 gets copied
End With

job = "whatever it is you need to be looking for"   '<<<<<<<<<<<<<<<<<<<<<

Set fndJob = Range("SubLotColumn").Find(What:=job, LookIn:=xlValues, Lookat:=xlWhole)
If Not fndJob Is Nothing Then
    MsgBox job & " was found at address " & fndJob.Address
    Exit Sub
Else
    With Sheets("Calendar")
        'Insert Blank Row
        .Unprotect
        .Rows(10).Insert
        'Copy Template row 5 to newly inserted row
        Sheets("Template").Rows(5).Copy Destination:=.Rows(10)
        'Copy Shipping Date
        .Range("B10") = sh.Range("A1")
        'Copy Subdivision/Lot Number
        .Range("C10") = sh.Range("I1")
        'Copy Model
        .Range("F10") = sh.Range("E1")
        'Copy Elevation
        .Range("G10") = sh.Range("F1")
        'Copy Garage Handling
        .Range("H10") = sh.Range("G1")
        'Copy Added By
        .Range("BQ10") = sh.Range("J1")
        'Copy Date/Time Added
        .Range("BR10") = sh.Range("K1")
        .Protect
    End With
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True
   
End Sub