It has been years since I've coded and I've tried many variations of looping. I've also spent many hours on StackOverflow, I am very greatful for the work you all put in.
I have 2 sheets, 1 workbook. Sheet1=DD and has thousands more records than sheet 2 (LC which has updated record info). All of the records from DD need to be moved to LC. However, there are many records that match from DD to LC, and the entire row from DD needs to replace the LC row. If the value in DD does not match an existing record in LC then the entire row needs to be moved to the end of LC.
Dim wsDD As Worksheet, wsLC As Worksheet 'shortens the names for each worksheet (ws) and records range (rng)
Dim rngDD As Range, rngLC As Range, colRng As Range
Dim lastRowDD As Long, lastRowLC As Long
Dim lastUIDused As Long 'holds the value of the last LC Unique ID when UniqueID col sorted by small-large
Dim ohnDD As Range, ohnLC As Range 'Old Host Number in DD or LC
Set wsDD = ThisWorkbook.Sheets("DataDump")
Set wsLC = ThisWorkbook.Sheets("LifeCycleAllRecs")
Set rngDD = wsDD.Range("A2", wsDD.Range("A" & wsDD.Cells(Rows.Count, 1).End(xlUp).Row)) 'finds & stores range of all used rows and columns in DataDump
Set rngLC = wsLC.Range("A2", wsLC.Range("A" & wsLC.Cells(Rows.Count, 1).End(xlUp).Row)) 'finds & stores range of all used rows and columns in LifeCycle
lastRowDD = wsDD.Range("A" & Rows.Count).End(xlUp).Row 'stores last row # in DataDump
lastRowLC = wsLC.Range("A" & Rows.Count).End(xlUp).Row 'stores last row # in LifeCycle tab
----------------- example 1-------------------
Set ohnDD = wsDD.Range("A2")
Set ohnLC = wsLC.Range("A2")
wsDD.Activate
Range("A2").Activate
Do Until ohnDD > lastRowDD
Set ohnLC = wsLC.Range("A2")
MsgBox "ohndd " & ohnDD & " lastrowdd " & lastRowDD
If ohnDD = ohnLC Then
wsDD.Range("A" & ohnDD.Row & ":U" & ohnDD.Row).Cut wsLC.Range("H" & ohnLC.Row)
wsLC.Activate
ohnDD = ohnDD + 1
Else
For Each ohnLC In wsLC.Range("X2:X" & lastRowLC)
wsDD.Range("A" & ohnDD.Row & ":U" & ohnDD.Row).Cut wsLC.Range("H" & lastlcrow + 1)
lastRowLC = lastRowLC + 1
ohnDD = ohnDD + 1
Loop
End If
----------------- example 2-------------------
'looks only for non-matching DD records
Set ohnDD = wsDD.Range("A2")
Set ohnLC = wsLC.Range("A2")
wsDD.Activate
Range("A2").Activate
For Each ohnDD In wsDD.Range("Q2:Q" & lastRowDD)
For Each ohnLC In wsLC.Range("X2:X" & lastRowLC)
If ohnDD.Value <> ohnLC.Value Then
Else
End If
Next ohnLC
Next ohnDD
' cuts each matching DD row and pastes to LC
Set ohnDD = wsDD.Range("A2")
Set ohnLC = wsLC.Range("A2")
wsDD.Activate
Range("A2").Activate
For Each ohnDD In wsDD.Range("Q2:Q" & lastRowDD)
For Each ohnLC In wsLC.Range("X2:X" & lastRowLC)
If ohnDD.Value = ohnLC.Value Then
wsDD.Range("A" & ohnDD.Row & ":U" & ohnDD.Row).Cut wsLC.Range("H" & ohnLC.Row)
Else
End If
Next ohnLC
Next ohnDD 'only non-matching records should remain in DD
----------------- example 3 oldest attempt-------------------
'match returns a row number
'for each cell in DD column Q, match with a cell in LC col X and return row number
wsDD.Activate
For Each ohnDD In wsDD.Range("Q2:Q" & lastRowDD) '5114 recs but only non blank
If ohnDD.Value > 0 Then 'ONLY IF NOT BLANK
For Each ohnLC In wsLC.Range("X2:X" & lastRowLC)
If ohnDD.Value = ohnLC.Value Then
wsDD.Range("A" & ohnDD.Row & ":U" & ohnDD.Row).Cut wsLC.Range("H" & ohnLC.Row)
Else
End If
Next ohnLC
Else
End If
Next ohnDD
This is has cost me days of getting nothing else done! I'm finally asking for help. I appreciate all help!
Aucun commentaire:
Enregistrer un commentaire