Checking to see if value exists before proceeding?

jmpatrick

Board Regular
Joined
Aug 17, 2016
Messages
230
Office Version
  1. 365
Platform
  1. Windows
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:

VBA 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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,268
Office Version
  1. 2010
Platform
  1. Windows
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
VBA Code:
 '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
VBA Code:
'Copy Shipping Date
Sheets("Calendar").Range("B10") = Sheets("JobGrid").Range("A1")



Maybe you can work with something along the lines of
VBA Code:
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
 

Forum statistics

Threads
1,147,475
Messages
5,741,347
Members
423,656
Latest member
Medrok2021

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
Top