lundi 30 juillet 2018

VBA Trying to overwrite matching records and move non-matching records from ws1 to ws2

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