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

jmpatrick

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

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("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?
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,232
Office Version
  1. 2010
Platform
  1. Windows
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

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

Board Regular
Joined
Aug 17, 2016
Messages
187
Office Version
  1. 365
Platform
  1. Windows
Well, first problem: Discovered I can't use custom views. That's a biggie.
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,232
Office Version
  1. 2010
Platform
  1. Windows
Is it reasonable to think that you not responding to the first or last question indicates they are non-issues?
 

Forum statistics

Threads
1,143,619
Messages
5,719,764
Members
422,244
Latest member
AYSHANA

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