Move entire row to another sheet based on dynamic cell value

[jiveass1960]

Hello,

I'm trying to tweak a few different things to improve upon my current code. The current code works but seems extremely slow. Ultimately what it does is update a master sheet with shipping data when the temp sheet has a matching unique shipping ID on the master sheet.

Private Sub CommandButton1_Click()

Application.Interactive = False

Dim Cl As Range
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Shipment")
For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
Dic.Item(Cl.Value) = Cl.Offset(, 1).Resize(, 5)
Next Cl
End With
With Sheets("Master")
For Each Cl In .Range("O2", .Range("O" & Rows.Count).End(xlUp))
If IsEmpty(Cl.Offset(, 2).Value) Then
Cl.Offset(, 2).Resize(, 5) = Dic.Item(Cl.Value)
End If
Next Cl
End With
Sheets("Shipment").Range("A2:A100").ClearContents
Sheet4.Activate
Application.Interactive = True
End Sub

This works but it takes quite a while (30-45 seconds) which isn't the worst thing in the world. Why I'm posting this is to find out if there is a better way of accomplishing this? I found this code which looked promising but it uses a static value "Done". I need this value to be dynamic as they matching would be based on the shipping ID's that are unique. The user who wrote this was trying to match two sheets(sheet1 & sheet2) and when there is a match, move the row to a new sheet (sheet3). Here is what I need to figure out. I need to compare sheet(Shipment), column A with sheet(Master) column O. When there is a match, copy sheet(Shipment), matching row (column B thru F) to sheet(Master), matching row (column Q thru U) and then clear the row that was copied from sheet(Shipment).


Sub Test()

Dim xRg As Range
Dim yRg As Range
Dim I As Long
Dim J As Long

I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet3").UsedRange.Rows.Count
secRow = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet3").UsedRange) = 0 Then J = 0
End If

Set xRg = Worksheets("Sheet1").Range("B2:B100")
Set yRg = Worksheets("Sheet2").Range("C1:C" & secRow)

On Error Resume Next
Application.ScreenUpdating = False
Dim M As Long
Dim N As Long

For N = 1 To xRg.Count
For M = 1 To yRg.Count
If CStr(xRg(N).Value) = CStr(yRg(M).Value) Then
yRg(M).EntireRow.Copy Destination:=Worksheets("Sheet3").Range("A" & J + 1)
yRg(M).EntireRow.Delete
If CStr(xRg(N).Value) = CStr(yRg(M).Value) Then
N = N - 1
End If
J = J + 1
End If
Next

Next

Application.ScreenUpdating = True
End Sub

 

[jiveass1960]

I'm unable to edit my post but I wanted to add a big thank you to Fluff for developing the original code which is working. I've been making additional changes/upgrades to this form and figured I would look into alternative methods of managing this process. Apologies for typo's as I can't edit my original post.

Thank you all for your support and patience!

 

[Fluff]

How many rows of data do you have on both sheets?

 

[jiveass1960]

Hi Fluff! The master sheet has around 400 but we are constantly growing that by 2-5 per week. The shipping sheet never has more than 100 because it is cleared after each match. A static range can be used with the shipping sheet but if it's possible for the master to be dynamic or to perform a count/last row with data type reference before beginning the matching, maybe that would help.

Thank you in advance!

 

[Fluff]

If that code is taking over 30 seconds on that amount of data you have something else going on.
Do you have an change events running on the Master sheet?

 

[jiveass1960]

Not sure I know exactly what that means but the data on master is less than 24 columns and currently at 452 rows long. It also is completely static. No formulas or converting is happening. All data is placed copied to that sheet as either text or numeric values. Thank you again!

 

[Fluff]

If you look in the Master Sheets code module do you have a procedure that starts with

Private Sub Worksheet_Change(ByVal Target As Range)

 

[jiveass1960]

There isn't any code in the master sheet or the shipping sheet. The code you provided is in a module that is being referenced by a user form.

 

[Fluff]

That code takes ~0.5 seconds for me with 8500 rows of data on each sheet.
Therefore there is something else going on which is slowing it down.

 

[jiveass1960]

Hmmm. The shipping sheet where the source data is does have formula references to another sheet, variables. The five cells being copied to master are calculated fields, not just static entries. Would this possibly be causing it?