Editing code to stop user from jumping from sheet to sheet - vba

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!

Answer 1

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

Answer 2

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