Code is lagging a while when run

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,815
Office Version
  1. 2007
Platform
  1. Windows
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

Rich (BB code):
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
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,660
Office Version
  1. 2010
Platform
  1. Windows
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)
VBA Code:
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

Board Regular
Joined
Nov 10, 2017
Messages
67
It could also help if you tried using:

Code:
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

Well-known Member
Joined
Dec 23, 2017
Messages
1,660
Office Version
  1. 2010
Platform
  1. Windows
It could also help if you tried using:

Code:
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:
VBA Code:
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

Well-known Member
Joined
Nov 16, 2010
Messages
3,815
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Nov 16, 2010
Messages
3,815
Office Version
  1. 2007
Platform
  1. Windows
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
 

Attachments

  • 1260.jpg
    1260.jpg
    229.8 KB · Views: 2

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,660
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Try this, which starts the entry at row 6:
VBA Code:
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

Well-known Member
Joined
Nov 16, 2010
Messages
3,815
Office Version
  1. 2007
Platform
  1. Windows
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

Well-known Member
Joined
Dec 23, 2017
Messages
1,660
Office Version
  1. 2010
Platform
  1. Windows
I finally found time to test this, so try this code which deals with names before the first or after the last one:
VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,017
Messages
5,599,362
Members
414,306
Latest member
Dennis_vdw

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