Editing code to stop user from jumping from sheet to sheet

Question

I have some code that copies data from one sheet on to another and then deletes empty rows. The code kind of works, but i sends the user from sheet to sheet while doing it. I am still new to VBA and im now sure how to achieve the result without using the select property. What I need to code to do, is move data from one sheet to another and delete empty rows when a button is clicked. I want the user to stay on the front page while the code executes. My code is below:

Sub MarkSold()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer

   On Error GoTo Err_Execute

   'Start search in row 6
   LSearchRow = 6

   'Start copying data to row 6 in Sheet3 (row counter variable)
   LCopyToRow = 6

   While Len(Sheets("on stock").Range("B" & CStr(LSearchRow)).Value) > 0

      'If value in column B = "D5", copy entire row to Sheet3
      If Sheets("On stock").Range("B" & CStr(LSearchRow)).Value = Sheets("Data Entry").Range("D5") Then

         'Select row in Sheet1 to copy
         Sheets("On stock").Select
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Cut

         'Paste row into Sheet2 in next row
         Sheets("Turbines sold").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste

         'Move counter to next row
         LCopyToRow = LCopyToRow + 1

         'Go back to Sheet1 to continue searching
         Sheets("On stock").Select

      End If

      LSearchRow = LSearchRow + 1

   Wend

Dim sh As Worksheet
Dim lr As Long, i As Long
    Set sh = Sheets("On stock")
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False

            lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
            For i = lr To 6 Step -1
                If WorksheetFunction.CountA(Rows(i)) = 0 Then
                    Rows(i).EntireRow.Delete
                End If
            Next i

        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayStatusBar = True
        .ScreenUpdating = True
    End With

Call setupDV

   'Position on cell A3
   Application.CutCopyMode = False
   Sheets("Data Entry").Range("A1").Select

   MsgBox "Now marked as sold!"

   Exit Sub

Err_Execute:
   'MsgBox "An error occurred."

End Sub

Any help is appreciated!

I'd advice you to have a look at `Application.ScreenUpdating` and https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — eirikdaude, Dec 19 '17 at 10:04

score 0 · Answer 1 · answered May 16 '21 at 04:49

Just remove the .Select statement from your code and set refer your code directly to each sheet. Just like The code below:

Sub MarkSold()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

Set stock = Sheets("On stock")
Set tSold = Sheets("Turbines sold")
Set dEntry = Sheets("Data Entry")
On Error GoTo Err_Execute

'Start search in row 6
LSearchRow = 6

'Start copying data to row 6 in Sheet3 (row counter variable)
LCopyToRow = 6

While Len(Sheets("on stock").Range("B" & CStr(LSearchRow)).Value) > 0

  'If value in column B = "D5", copy entire row to Sheet3
  If Sheets("On stock").Range("B" & CStr(LSearchRow)).Value = Sheets("Data Entry").Range("D5") Then

     'Select row in Sheet1 to copy
     Sheets("On stock").Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Cut

     'Paste row into Sheet2 in next row
     Sheets("Turbines sold").Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Paste

     'Move counter to next row
     LCopyToRow = LCopyToRow + 1

  End If

  LSearchRow = LSearchRow + 1

Wend

Dim sh As Worksheet
Dim lr As Long, i As Long
Set sh = Sheets("On stock")
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = False
    .Calculation = xlCalculationManual
    .EnableEvents = False

        lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
        For i = lr To 6 Step -1
            If WorksheetFunction.CountA(Rows(i)) = 0 Then
                Rows(i).EntireRow.Delete
            End If
        Next i

    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayStatusBar = True
    .ScreenUpdating = True
End With

Call setupDV

Application.CutCopyMode = False

MsgBox "Now marked as sold!"

Exit Sub

Err_Execute:
'MsgBox "An error occurred."

End Sub

score -1 · Answer 2 · answered Dec 19 '17 at 10:20

I've cleaned up your code a little and commented on it, so you can follow the reasoning for the changes:

Sub MarkSold()
Dim sh As Worksheet
Dim lr As Long
Dim i As Long
Dim LSearchRow As Long
Dim LCopyToRow As Long
'the variables above ought to be declared as Long instead of Integer, as there
'are more cells in Excel than there are Integer values
On Error GoTo Err_Execute

   'Start search in row 6
LSearchRow = 6
   'Start copying data to row 6 in Sheet3 (row counter variable)
LCopyToRow = 6

    While Len(Sheets("On stock").Range("B" & LSearchRow).Value) > 0
      'If value in column B = "D5", copy entire row to Sheet3
      If Sheets("On stock").Range("B" & LSearchRow).Value = Sheets("Data Entry").Range("D5") Then
         'Select row in Sheet1 to copy
         Sheets("On stock").Rows(LSearchRow).Cut
         'Paste row into Sheet2 in next row
         Sheets("Turbines sold").Rows(LCopyToRow).Paste
         'Move counter to next row
         LCopyToRow = LCopyToRow + 1
         'Go back to Sheet1 to continue searching
      End If
      LSearchRow = LSearchRow + 1
    Wend

    Set sh = Sheets("On stock")
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False

            lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
            For i = lr To 6 Step -1
                If WorksheetFunction.CountA(Rows(i)) = 0 Then
                    Rows(i).EntireRow.Delete
                End If
            Next i

        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayStatusBar = True
        .ScreenUpdating = True
    End With

Call setupDV

   'Position on cell A3
   Application.CutCopyMode = False
   Sheets("Data Entry").Range("A1").Select
   'Do you really need the select command above?
   MsgBox "Now marked as sold!"
   Exit Sub
Err_Execute:
   'MsgBox "An error occurred."
End Sub

Editing code to stop user from jumping from sheet to sheet

2 Answers2