How to optimize Macro Code That Looks into 2 Worksheets - excel

Question

Problem:
I have 1 Excel Sheet with 2 tabs
Tab 1 = Shipment Package
Tab 2 = Mass Update Steps
I want to go through all the values in column B of Tab 2 one by one.
As I go through each row in Tab 2, I will select and copy the values in column C and D of Tab 2.
After selecting and copying, I want to find Tab 2-column B's corresponding values in Tab 1 column G.
If a match is found, I will select column E of Tab 1 (in row where the match was found), and paste there the values copied from Tab 2.
So far this is the code I have which works. However the values from being searched are hard coded. With the values growing in number in Tab 2, the code is hard to maintain. I would like to optimize it. I have googled several possible solutions. But I keep on getting these run-time errors when declaring or setting the range for the 2 sheets. Here is my code.
Private Sub btn_Updt_Steps_Click()
Dim lastRow As Long
With Sheets("Shipment Package")
.Activate
lastRow = .Range("G65000").End(xlUp).Row
For i = 1 To lastRow
If (InStr(1, .Range("G" & i).Value, "Code 001", vbTextCompare) > 0) Then
Sheets("Mass Update Steps").Activate
ActiveSheet.Range("C4:D4").Select
Selection.Copy
Sheets("Shipment Package").Activate
.Range("E" & i).Select
ActiveSheet.Paste
ElseIf (InStr(1, .Range("G" & i).Value, "Code 002", vbTextCompare) > 0) Then
Sheets("Mass Update Steps").Activate
ActiveSheet.Range("C5:D5").Select
Selection.Copy
Sheets("Shipment Package").Activate
.Range("E" & i).Select
ActiveSheet.Paste
ElseIf (InStr(1, .Range("G" & i).Value, "Code 003", vbTextCompare) > 0) Then
Sheets("Mass Update Steps").Activate
ActiveSheet.Range("C6:D6").Select
Selection.Copy
Sheets("Shipment Package").Activate
.Range("E" & i).Select
ActiveSheet.Paste
End If
Next
End With
NotFoundErr:
Debug.Print "value not found"
End Sub
Solution:
Private Sub btn_Updt_Steps_Click()
Dim i As Long
Dim j As Long
Dim Tab2ColC As String
Dim Tab2ColD As String
Dim Tab1ColE As String
Dim Tab1ColF As String
Tab1 = "Shipment Package"
Tab2 = "Mass Update Steps"
With Worksheets(Tab1)
LastRowTab1 = .Cells(.Rows.Count, "G").End(xlUp).Row 'LastRowInColumn(2, Tab1)
End With
With Worksheets(Tab2)
LastRowTab2 = .Cells(.Rows.Count, "B").End(xlUp).Row 'LastRowInColumn(2, Tab2)
End With
For i = 4 To LastRowTab2
Tab2ColumnB = Trim(Sheets(Tab2).Range("B" & i).Value)
Sheets(Tab2).Activate
If Tab2ColumnB <> "" Then
Tab2ColC = "C" & i
Tab2ColD = "D" & i
ActiveSheet.Range(Tab2ColC, Tab2ColD).Copy
For j = 16 To LastRowTab1
Tab1ColumnG = Trim(Sheets(Tab1).Range("G" & j).Value)
If Tab1ColumnG = Tab2ColumnB Then
Sheets(Tab1).Activate
Tab1ColE = "E" & j
Tab1ColF = "F" & j
Sheets(Tab1).Range(Tab1ColE, Tab1ColF).Select
ActiveSheet.Paste
End If
Next
End If
Next
End Sub

Answer 1

For optimization, you can avoid select statements, activate statements etc. Check the code below.
For i = 1 To lastRow
Application.ScreenUpdating = False
If YourCondn1 Then
Sheets("Mass Update Steps").Range("C4:D4").Copy
Sheets("Shipment Package").Range("E" & i).PasteSpecial xlPasteAll
ElseIf YourCondn2 Then
Sheets("Mass Update Steps").Range("C5:D5").Copy
Sheets("Shipment Package").Range("E" & i).PasteSpecial xlPasteAll
ElseIf YourCondn3 Then
Sheets("Mass Update Steps").Range("C6:D6").Copy
Sheets("Shipment Package").Range("E" & i).PasteSpecial xlPasteAll
End If
Application.ScreenUpdating = True
Next
Adding the code that you require. Hope this will work. I haven't tested it. Please check.
Private Sub btn_Updt_Steps_Click()
'Finding LastRow in Tab 2
Tab1 = "Shipment Package"
Tab2 = "Mass Update Steps"
With Worksheets(Tab2)
LastRowTab2 = .Cells(.Rows.Count, 2).End(xlUp).Row 'LastRowInColumn(2, Tab2)
End With
MatchFound = 0
For i = 1 To LastRowTab2
'checking whether value in tab2 column b is same as tab1 column g
Tab2ColumnB = Trim(Sheets(Tab2).Range("B" & i).Value)
Tab1ColumnG = Trim(Sheets(Tab1).Range("G" & i).Value)
If Tab2ColumnB = Tab1ColumnG Then
Tab2ColumnC = Trim(Sheets(Tab2).Range("C" & i).Value)
Tab2ColumnD = Trim(Sheets(Tab2).Range("D" & i).Value)
Sheets(Tab1).Range("E" & i).Value = Tab2ColumnC
Sheets(Tab1).Range("F" & i).Value = Tab2ColumnD
MatchFound = MatchFound + 1
End If
Next
If MatchFound = 0 Then
MsgBox "No matches found"
ElseIf MatchFound > 0 Then
MsgBox MatchFound & " matches were found."
End If
End Sub

Answer 2

I think you can achieve what you want with simple Excel formulas.
In Shipment Package, type the following into E1 and F1 and then drag formula down:
E1 = VLOOKUP(G1,'Mass Update Steps'!$B$1:$D$20,2,0)
F1 = VLOOKUP(G1,'Mass Update Steps'!$B$1:$D$20,3,0)
NB - you'll need to amend $B$1:$D$20 depending on how much data you have in Mass Update
Finally, this assumes that there is always a match. If not, and you want to get rid of those pesky #N/A values, then update the formuals with ISNA e.g.
E1 = IF(ISNA(VLOOKUP(G1,'Mass Update Steps'!$B$1:$D$4,2,0)),"",VLOOKUP(G1,'Mass Update Steps'!$B$1:$D$4,2,0))
Hope that helps.