Inserting UserForm data into new row whose location is based on date?

[jmpatrick]

I have a sprawling macro that I've been working with and I'm trying to simplify it greatly by eliminating copying and pasting to/from helper sheets as well as the use of selecting as much as possible.

Basically, I have a UserForm to enter new rows on my main sheet. The crazy process goes like this:

1. Take data from UserForm and populate a helper sheet.
2. Insert blank row on row 10 of main sheet and copy and paste formulas to the new row from a template page.
3. Copy data from helper sheet to blank row 10 on main sheet.
4. Create some cool folders.
5. Re-sort main sheet.
6. Delete all formatting because Conditional Formatting is a mess after inserting new row.
7. Copy formatting from template page and apply it to main sheet.
8. Restore all link colors back to blue.
9. Scroll to newly entered row.

It's slow as you can imagine.

My thought is that the process should really be:

1. Insert new row based on the date from the UserForm.
2. Grab all formatting and formulas from the row above.
3. Populate data from UserForm.
4. Create some cool folders.
5. Scroll to newly entered row.

Here's my 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("Calendar").Range("B10") = Sheets("JobGrid").Range("A1")
      
    'Copy Subdivision/Lot Number
    Sheets("Calendar").Range("C10") = Sheets("JobGrid").Range("I1")
             
    'Copy Model
    Sheets("Calendar").Range("F10") = Sheets("JobGrid").Range("E1") & "%"
         
    'Copy Elevation
    Sheets("Calendar").Range("G10") = Sheets("JobGrid").Range("F1")
      
    'Copy Garage Handling
    Sheets("Calendar").Range("H10") = Sheets("JobGrid").Range("G1")
      
    'Copy Added By
    Sheets("Calendar").Range("BQ10") = Sheets("JobGrid").Range("J1")
  
    'Copy Date/Time Added
    Sheets("Calendar").Range("BR10") = Sheets("JobGrid").Range("K1")
      
    'Moves SubCode To LotGrid
    Sheets("LotGrid").Visible = True
    Sheets("LotGrid").Range("A1") = Sheets("JobGrid").Range("B1")

    'Moves Lot Number To LotGrid
    Sheets("LotGrid").Range("E1") = Sheets("JobGrid").Range("D1")
             
    'Creates Lot Folder
    Call CreateLotFolder
  
    'Re-sort Calendar
    Sheets("Calendar").Select
    Application.Goto Reference:="Calendar"
    Selection.EntireRow.Hidden = False

    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Add Key:=Range( _
        "DateColumn"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Add Key:=Range( _
        "SubLotColumn"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Calendar").Sort
        .SetRange Range("CalendarAllColumns")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
      
    'Convert DateColumn to links
    Dim Cl As Range
       For Each Cl In Range("DateColumn", Range("B" & Rows.Count).End(xlUp))
    ActiveSheet.Hyperlinks.Add Anchor:=Cl, Address:="", SubAddress:= _
        Cl.Address, ScreenTip:="Click To Change Date"
      Next Cl
  
    'Reset formatting
    Cells.FormatConditions.Delete
    Sheets("Template").Select
    Range("Template").Select
    Selection.Copy
    Sheets("Calendar").Select
    Range("Calendar").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Template").Visible = False
    Sheets("JobGrid").Visible = False
  
    'Reset link color
    Dim hl As Hyperlink
    For Each hl In ActiveSheet.Hyperlinks
    hl.Range.Font.Color = RGB(0, 0, 255)
    Next
  
    'Protect Calendar Sheet
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
      
    'Go to new job
    Cells.Find(What:="%", After:=[a1], LookIn:=xlFormulas, _
        LookAt:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False).Activate
      
    With ActiveCell
        If Right(.Value, 1) = "%" Then .Value = Left(.Value, Len(.Value) - 1)
    End With

Application.Goto ActiveCell.EntireRow, True

ActiveWindow.SmallScroll Down:=-10

    MsgBox ("New Job Successfully Added!")

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

The first stumbling block is inserting a new row based on the date from the UserForm.

The second issue is grabbing all formatting and formulas from the row above.

Will this make a mess of my Conditional Formatting?

 

[NoSparks]

The first stumbling block is inserting a new row based on the date from the UserForm.

Why, aren't you re-sorting after writing the data anyway ?
If there's issues you'll need to give info as to how/what/where/why the date would determine where the insert should be.

The second issue is grabbing all formatting and formulas from the row above.

True Excel Tables do that automatically.

Will this make a mess of my Conditional Formatting?

Don't know, does the sorting mess it up now?

 

[jmpatrick]

Why, aren't you re-sorting after writing the data anyway ?
If there's issues you'll need to give info as to how/what/where/why the date would determine where the insert should be.


True Excel Tables do that automatically.


Don't know, does the sorting mess it up now?

First thing: My sheet isn't a table. I'll convert it and see where it gets me.

 

[jmpatrick]

Well, first problem: Discovered I can't use custom views. That's a biggie.

 

[NoSparks]

Is it reasonable to think that you not responding to the first or last question indicates they are non-issues?