Merging two rows together with the purpose of having one updated record

[ikey99]

Hi, so I have thousands of records that are each in a set of two rows. The data in these two rows need to be combined into one row so that the data is updated can be imported into our CRM system. So for a while, our company was using two CRM systems for inputting customer data, therefore each record has two rows. some columns are missing in each row and they're not consistent. How do I go about combining these two rows into one complete row with updated correct data?

For the most part, it will be as easy as one row will have a blank column where the other doesn't and they can be easily combined, but not sure how to go about rows that both have data but they are different. Obviously, I can find which one is the updated data but idk how to scale that for 5000+

 

[Peter_SSs]

I will have another think about it given this change of circumstance.

While I am doing that .. Are these real details of the people mentioned in the sample data?
I'm asking in relation to #11 of the Forum Rules

BTW, even though the previous code will not work correctly given that not all data uses two rows, it does not error for me with that sample data.

 

[ikey99]

While I am doing that .. Are these real details of the people mentioned in the sample data?
I'm asking in relation to #11 of the Forum Rules

BTW, even though the previous code will not work correctly given that not all data uses two rows, it does not error for me with that sample data.

Yeah, Please delete that post.

BTW, even though the previous code will not work correctly given that not all data uses two rows, it does not error for me with that sample data.

That's strange, it must be something within my excel installation. I will look for solutions

 

[Peter_SSs]

I have removed the sample data.

I think this code should take care of the 2 rows/1 row issue so give it a try and see what happens

Sub CombineRows_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, uba2 As Long
  
  With Range("A1").CurrentRegion.Offset(1)
    a = .Value
    uba2 = UBound(a, 2)
    ReDim b(1 To UBound(a), 1 To uba2)
    For i = 1 To UBound(a) - 1
      k = k + 1
      If a(i, 1) = a(i + 1, 1) Then
        For j = 1 To uba2
          Select Case True
            Case a(i, j) = a(i + 1, j)
              b(k, j) = a(i, j)
            Case IsEmpty(a(i, j)) Or IsEmpty(a(i + 1, j))
              b(k, j) = a(i, j) & a(i + 1, j)
            Case Else
              b(k, j) = a(i, j) & "|" & a(i + 1, j)
          End Select
        Next j
        i = i + 1
      Else
        For j = 1 To uba2
          b(k, j) = a(i, j)
        Next j
      End If
    Next i
    .Value = b
    .Replace What:="*|*", Replacement:="#N/A"
    On Error Resume Next
    .SpecialCells(xlConstants, xlErrors).Interior.Color = vbCyan
    On Error GoTo 0
    .Value = b
  End With
End Sub