Code is lagging a while when run

[ipbr21054]

Evening.

I am using the code as supplied below.

I enter the data in my userform.
I then transfer the data to my worksheet & see the userform close.
I see the data entered at row 5
I NOW SEE THE CURSOE GOING ROUND & ROUND
I then see the success message.
I then click ok.

So the lag that i see must be the sorting process.

Please advise if you see an issue of why this is happening or maybe advice how to condense the code if need be.

Thanks

Private Sub TransferButton_Click()

Dim i As Long
Dim x As Long
Dim ctrl As Control
Dim lastrow As Long

Cancel = 0
If TextBox1.Text = "" Then
    Cancel = 1
    MsgBox "CUSTOMER'S NAME FIELD IS EMPTY", vbCritical, "RANGER FIELD EMPTY MESSAGE"
    TextBox1.SetFocus
    
ElseIf TextBox2.Text = "" Then
    Cancel = 1
    MsgBox "VIN FIELD IS NOT ENTERED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
    TextBox2.SetFocus

ElseIf ComboBox5.Text = "" Then
    Cancel = 1
    MsgBox "YEAR IS NOT ENTERED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
    ComboBox5.SetFocus
    
ElseIf ComboBox1.Text = "" Then
    Cancel = 1
    MsgBox "MY PART NUMBER IS NOT ENTERED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
    ComboBox1.SetFocus
    
ElseIf ComboBox2.Text = "" Then
    Cancel = 1
    MsgBox "FORD PART NUMBER IS NOT ENTERED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
    ComboBox2.SetFocus
    
ElseIf ComboBox3.Text = "" Then
    Cancel = 1
    MsgBox "ITEM IS NOT ENTERED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
    ComboBox3.SetFocus
    
ElseIf ComboBox4.Text = "" Then
    Cancel = 1
    MsgBox "TYPE IS NOT ENTERED", vbCritical, "RANGER FIELD EMPTY MESSAGE"
    ComboBox4.SetFocus

End If

If Cancel = 1 Then
        Exit Sub
End If

Rows("5:5").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B5:H5").Borders.LineStyle = xlContinuous
Range("B5:H5").Borders.Weight = xlThin
Range("B5:H5").Interior.ColorIndex = 6
Range("C5:H5").HorizontalAlignment = xlCenter
Range("B5").HorizontalAlignment = xlLeft
Sheets("RANGER").Range("B5").Select

Cancel = 0

If Cancel = 1 Then
Exit Sub

End If
    
With ThisWorkbook.Worksheets("RANGER")
    .Range("B5").Value = TextBox1.Text
    .Range("D5").Value = TextBox2.Text
    .Range("C5").Value = ComboBox5.Text
    .Range("E5").Value = ComboBox1.Text
    .Range("F5").Value = ComboBox2.Text
    .Range("G5").Value = ComboBox3.Text
    .Range("H5").Value = ComboBox4.Text

End With

With Sheets("RANGER")

If .AutoFilterMode Then .AutoFilterMode = False
    x = .Cells(.Rows.Count, 5).End(xlUp).Row
    .Range("A4:H" & x).Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess
    
    End With

    Unload RangerForm
    ActiveWorkbook.Save
    MsgBox "DATABASE HAS BEEN UPDATED", vbInformation, "SUCCESSFUL MESSAGE"
        

    Application.ScreenUpdating = True

Range("B6").Select
Range("B5").Select
End Sub

 

[offthelip]

You can avoid doing the sort entirely by using the Match function to find out where in column B your current value would fit and the inserting the row at that point: Try this code (untested)

Dim tst As String
Dim rr As Range

Dim outarr(1 To 1, 1 To 7) As Variant
With Sheets("RANGER")
 x = .Cells(.Rows.Count, 5).End(xlUp).Row
Set rr = Range(Cells(1, 2), Cells(x, 2))
tst = TextBox1.Text
tt = Application.WorksheetFunction.Match(tst, rr, 1)

Rows(tt).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

   outarr(1, 1) = TextBox1.Text   ' I have used a varaint array to speed this up a bit
    outarr(1, 2) = TextBox2.Text
    outarr(1, 3) = ComboBox5.Text
    outarr(1, 4) = ComboBox1.Text
    outarr(1, 5) = ComboBox2.Text
    outarr(1, 6) = ComboBox3.Text
    outarr(1, 7) = ComboBox4.Text
    .Range(.Cells(tt, 2), .Cells(tt, 8)) = outarr
End With
End Sub

 

[R2ah1ze1l]

It could also help if you tried using:

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    iWindowState = .WindowState
    .WindowState = xlMinimized
End With

The code of your choice here

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    iWindowState = .WindowState
    .WindowState = xlMaximized
End With

I would wait for the first With grouping until after your textboxes are completed.
This will minimize your Excel window, allow the changes, Maximize your Excel window. When it maximizes you will know it has finished the task.[/code]

 

[offthelip]

It could also help if you tried using:

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    iWindowState = .WindowState
    .WindowState = xlMinimized
End With

The code of your choice here

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    iWindowState = .WindowState
    .WindowState = xlMaximized
End With

I would wait for the first With grouping until after your textboxes are completed.
This will minimize your Excel window, allow the changes, Maximize your Excel window. When it maximizes you will know it has finished the task.[/code]

I think your code should be:

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    iWindowState = .WindowState
    .WindowState = xlMinimized
End With

'The code of your choice here

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
  
    .WindowState = iWindowState
End With

I find that if the code is fast and efficient I very rarely need to do this

 

[ipbr21054]

Morning,
With regards post #2 ive applied that and done a few tests of which seem to be ok but if i enter a name that would be the first on this list i encounter an issue.

My range for the values to be entered should be from row 6 and down BUT it was entered into Row 2 ?

 

[ipbr21054]

I have added a screen shot of my sheet.
As you will see the first row with data will be row 5
The name in cell B5 is Dell so if i add a name say Dave then for some reason the sheet is then out of sync & Dave ends up in cell B2

Also if the last name is Steven & i add Thomas the name is inserted in the incorrect place on the for.

Basically it looks like the code will not correctly place the name in the list when using the first & last name that currently exists

 

[offthelip]

Try this, which starts the entry at row 6:

Dim tst As String
Dim rr As Range

Dim outarr(1 To 1, 1 To 7) As Variant
With Sheets("RANGER")
 x = .Cells(.Rows.Count, 5).End(xlUp).Row
Set rr = Range(Cells(6, 2), Cells(x, 2))
tst = TextBox1.Text
tt = Application.WorksheetFunction.Match(tst, rr, 1) + 5

Rows(tt).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

   outarr(1, 1) = TextBox1.Text   ' I have used a varaint array to speed this up a bit
    outarr(1, 2) = TextBox2.Text
    outarr(1, 3) = ComboBox5.Text
    outarr(1, 4) = ComboBox1.Text
    outarr(1, 5) = ComboBox2.Text
    outarr(1, 6) = ComboBox3.Text
    outarr(1, 7) = ComboBox4.Text
    .Range(.Cells(tt, 2), .Cells(tt, 8)) = outarr
End With
End Sub

 

[ipbr21054]

Will this also have any bearing for the top end of the names like where the last name starts with S and if I add a name starting with say T in previous code the name T was inserted BEFORE the S

 

[offthelip]

I finally found time to test this, so try this code which deals with names before the first or after the last one:

Sub test3()
Dim tst As String
Dim rr As Range

Dim outarr(1 To 1, 1 To 7) As Variant
With Sheets("RANGER")
 x = .Cells(.Rows.Count, 5).End(xlUp).Row
Set rr = Range(Cells(6, 2), Cells(x, 2))
tst = TextBox1.Text
On Error GoTo settt
tt = Application.WorksheetFunction.Match(tst, rr, 1)
cont:
On Error GoTo 0   ' restore general error handling
tt = tt + 6
   Rows(tt).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

   outarr(1, 1) = tst   ' I have used a varaint array to speed this up a bit"
    outarr(1, 2) = TextBox2.Text
    outarr(1, 3) = ComboBox5.Text
    outarr(1, 4) = ComboBox1.Text
    outarr(1, 5) = ComboBox2.Text
    outarr(1, 6) = ComboBox3.Text
    outarr(1, 7) = ComboBox4.Text
    .Range(.Cells(tt, 2), .Cells(tt, 8)) = outarr
End With
Exit Sub
settt:
tt = 0
GoTo cont
End Sub