VBA for Excel: Copy values of one row to another with a unique Identifier

Question

I have a large data set with a field (Column A) with two values, Parent and Child. There are parents connected to children with unique identifiers (Column B). Parents have Dates, but their respective children don't (Column C) and Parents and their respective children have different statutes (Column D).

I need find the parents with the Dates (C) and copy those dates (and the status [D]) of the Parents to their respective Children. Then, delete the Parent rows with dates and Parent and Children without dates, only leaving the data with the Children that have dates and all the information copied from their parents.

This is what I have (Assume Row with Columns A, B, C,and D names is the Header row):

This is the result I need:

Keep in mind that not all Parents have Dates or Children, but all children have a parent. Parent can also have at most two Children.

Cannot simply change the name from Parent to Child, there is other data associated with children that the Parent does not have. The Children with Dates (and other data from parents) must be the ending result.

Here is the code I got so far (This is part of a longer code that I have yet to work out). It doesn't have any errors but the logic seems to be off. Not sure if I'm missing something.

Dim lastentry as Integer
Dim x as Long
Dim y as Range

lastentry=UsedRange.Rows(UsedRange.Rows.Count).Row
x=1

    '---Searches through first column for parents with dates, column 3. Then, sets values of parent to the child.---'

Do While Cells(x, 1).Value = "Parent" And IsDate(Cells(x, 3).Value) = True
    For Each y in Range("A2:A" & lastentry).Cells               '<---Starts on A2 to bypass Header row---'
        If y.Value = "Child" And Range("B" & y.Row).Value = Cells(x, 2).Value Then
            Range("C" & y.Row).Value = Cells(x, 3).Value
            Range("D" & y.Row).Value = Cells(x, 4).Value
            '--- Need to add more Columns here: E, F, G and so on, but not all Columns---"
        End if
    Next y
Loop

    '---Deletes all Parent rows and Children with no dates.---'

For Each y in Range("A2:A" & lastentry).Cells
    If y.Value = "Parent"
        y.EntireRow.Delete
    End If
Next y

For Each y in Range("C2:C" & lastentry).Cells
    If y.Value= ""
        y.EntireRow.Delete
    End If
Next y

user_15329544 · Answer

considering the child is always under the parent (AKA data is sorted by column B > A), and that your headers are in row 1, you can use something like this:

sub FixMyData()

   Dim ws as worksheet

   set ws = activeworksheet

   for i = 3 to ws.range("A3").end(xldown).row 'Assumes header is in row 1
      if ws.range("A" & i-1).value = ws.range("A" & i).value then
         ws.range("B" & i).value = ws.range("B" & i-1).value
         ws.range("C" & i).value = ws.range("C" & i-1).value
         ws.range("D" & i).value = ws.range("D" & i-1).value
         ws.range("A" & i-1 & ":D" & i-1).value = vbnullstring
       end if
   next i
end sub

Sorry I didnt test this in Excel, so you might get some compilation errors, but the logic should do the job.

Cheers.

VBA for Excel: Copy values of one row to another with a unique Identifier

1 Answers