Move Complete Rows to bottom of Worksheet

Change the End of your Save Macro to:=

With Sheets("Tool_Room")
LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Rows(frng.Row).Cut
    .Range("A" & LR).Insert Shift:=xlDown
End With

ThisWorkbook.Sheets("SOL").Protect Password:="abc" 'Protects worksheet again'
ThisWorkbook.Sheets("Tool_Room").Protect Password:="abc"

ThisWorkbook.Save

End Sub

This is does what I needed I am very thankful. I was wondering if it is possible for the rows to be entered sequentially. Meaning all the shop orders with a date complete entered are in order by shop number from least to greatest. For example if shop orders 4 and 6 both have date completed when I enter a date completed for shop order 5 for it to be moved in between row 4 and 6. Also when a new shop order is entered I want the new row to be at the bottom of the shop orders with no date complete but above the shop orders with a date complete. I am new to VBA and dont know the command string to add to UserForm1 to make this possible.

Easily done.

Move the Row to the bottom as we already have.

Then Find the first date in column H.

Then Sort from that row to the bottom by column A.


Change the end of your code to:

If Not frng Is Nothing Then
    With Me
        frng.Offset(, 2) = .ToolNumber_TB2
        frng.Offset(, 3) = .ToolMake1_CB
        frng.Offset(, 4) = .Hours1_TB2
        frng.Offset(, 5) = .ToolMake2_CB
        frng.Offset(, 6) = .Hours2_TB2
        frng.Offset(, 7) = .Complete_TB2
        frng.Offset(, 8) = .ToolingC_TB
        frng.Offset(, 9) = .CostM_TB
    End With
End If

With Sheets("Tool_Room")
LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Rows(frng.Row).Cut
    .Range("A" & LR).Insert Shift:=xlDown
    
SR = .Range("H" & LR).End(xlUp).Row

SortRange = Range("A" & SR & ":K" & LR).Address

    ActiveWorkbook.Worksheets("Tool_Room").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tool_Room").Sort.SortFields.Add2 Key:=Range("A" & SR & ":A" & LR) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tool_Room").Sort
        .SetRange Range(SortRange)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End With

ThisWorkbook.Sheets("SOL").Protect Password:="abc" 'Protects worksheet again'
ThisWorkbook.Sheets("Tool_Room").Protect Password:="abc"

ThisWorkbook.Save

End Sub

Try this code:

Private Sub SaveCh_CB_Click() 'Unprotects worksheets and saves informations back into database'
 
ThisWorkbook.Sheets("SOL").Unprotect Password:="abc"
ThisWorkbook.Sheets("Tool_Room").Unprotect Password:="abc"
 
Const strPass  As String = "Secret" 'Password to make changes in userform'
Dim strPassCheck As String
Dim lPassAttempts As Long, lCount As Long

Do Until lPassAttempts = 3
    lPassAttempts = 1 + lPassAttempts
        lCount = lCount + 1
        strPassCheck = InputBox("Password?", "Attempt " & lPassAttempts & " of 3")
    If strPassCheck = vbNullString Or lPassAttempts = 3 Then Exit Sub
    If strPassCheck = strPass Then Exit Do
Loop

MsgBox "Success"
 
 Dim findString As String, toolString As String
    Dim fndrng As Range, frng As Range
    
findString = Me.Shop_TB2.Value

Set fndrng = Sheets("SOL").Range("A:A").Find(What:=findString, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If Not fndrng Is Nothing Then
    With Me
        fndrng.Offset(, 1) = .Date_TB2
        fndrng.Offset(, 2) = .Name_TB2
        fndrng.Offset(, 3) = .Area_CB2
        fndrng.Offset(, 4) = .Account_TB2
        fndrng.Offset(, 5) = .PartNum_TB2
        fndrng.Offset(, 6) = .PartName_TB2
        fndrng.Offset(, 7) = .Quantity_TB2
        fndrng.Offset(, 8) = .RequestedDate_TB2
        fndrng.Offset(, 9) = .Complete_TB2
        fndrng.Offset(, 10) = .Build_TB2
    End With
End If
    
toolString = Me.Shop_TB2.Value

Set frng = Sheets("Tool_Room").Range("A:A").Find(What:=toolString, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If Not frng Is Nothing Then
    With Me
        frng.Offset(, 2) = .ToolNumber_TB2
        frng.Offset(, 3) = .ToolMake1_CB
        frng.Offset(, 4) = .Hours1_TB2
        frng.Offset(, 5) = .ToolMake2_CB
        frng.Offset(, 6) = .Hours2_TB2
        frng.Offset(, 7) = .Complete_TB2
        frng.Offset(, 8) = .ToolingC_TB
        frng.Offset(, 9) = .CostM_TB
    End With
End If

With Sheets("Tool_Room")

LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
'    .Rows(frng.Row).Cut
'    .Range("A" & LR).Insert Shift:=xlDown
    
    .Range("H12").Value = ""
    ActiveWorkbook.Worksheets("Tool_Room").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tool_Room").Sort.SortFields.Add2 Key:=Range( _
        "H8:H" & LR), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Tool_Room").Sort
        .SetRange Range("A8:J" & LR)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    

SR = .Range("H" & LR).End(xlUp).Row

    .Rows(SR + 1 & ":" & LR).Cut
    .Range("A8").Insert Shift:=xlDown

SR = LR - SR + 7

    ActiveWorkbook.Worksheets("Tool_Room").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tool_Room").Sort.SortFields.Add2 Key:=Range( _
        "A8:A" & SR), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Tool_Room").Sort
        .SetRange Range("A8:J" & SR)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
        ActiveWorkbook.Worksheets("Tool_Room").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tool_Room").Sort.SortFields.Add2 Key:=Range( _
        "A" & SR + 1 & ":A" & LR), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Tool_Room").Sort
        .SetRange Range("A" & SR + 1 & ":J" & LR)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End With


ThisWorkbook.Sheets("SOL").Protect Password:="abc" 'Protects worksheet again'
ThisWorkbook.Sheets("Tool_Room").Protect Password:="abc"

ThisWorkbook.Save

End Sub