Search code examples
excelvba

Copy values from previous rows (with same ID) to the blank cells on the last row (with the same ID)

enter image description here

As you see on the above picture, I have three rows with the same ID value ”1” .
Rows(“5:5”) is the last row which has ID value ”1” and it has two blank cells (E5:F5),
I need to fill these blank cells with corresponding value from the previous nearest row which has the same ID value ”1”,
If the previous corresponding value is also blank then seek for it in the before previous row (same ID value) and so on.
Rows(“6:6”) is the only row with ID value ”2”, so it will be kept as it is (even if it has blank values).
I could not find a direct way to fulfil my task and I have used the below long workarounds:
1- Insert a helper column and filled with serial number from 1 to lastRow on the sheet.
2- Sort column(A) xlAscending and the helper column xlDescending:
3- then Merge corresponding cells on the rows which have the same ID value.
4- UnMerge all the rows on the sheet.
5- use another macro to delete the blank rows.
6- at last delete the helper column.
The issue with these steps that it is time consuming and I am fear it may lead to hang excel application,
Note: in my actual dataset,the header is the first two rows.
In advance, great thanks for your help. 

Sub Inser_Column_and_Add_SerialNumber()
   Dim ws As Worksheet: Set ws = ActiveSheet
   Dim LastRow As Long, Count As Long, arr, arrA, i As Long
   LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Count = 1
    arr = ws.Range("A3:A" & LastRow).Value
    arrA = ws.Range("A3:A" & LastRow).Value
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then arrA(i, 1) = Count:  Count = Count + 1
    Next i
    ws.Range("B3").Resize(UBound(arrA), 1).Value = arrA
End Sub

This is the code of Merge corresponding cells on the rows which have the same ID value: 

Sub Merge_corresponding_Cell_on_Similar_Rows()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Dim ws As Worksheet:  Set ws = ActiveSheet
    
    If ws.AutoFilterMode Then
       ws.AutoFilter.ShowAllData        'Clear any Filter
    Else
       ws.Rows("2:2").AutoFilter
    End If
       
    ws.Sort.SortFields.Clear            'Clear any previous sorting

    ws.AutoFilter.Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.AutoFilter.Sort.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ws.AutoFilter.Sort.Apply

    Dim LastRow As Long, lastCol As Long, arrWork, i As Long, j As Long, k As Long

    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
     
    arrWork = ws.Range("A2:A" & LastRow).Value2
    
    For i = 1 To UBound(arrWork) - 1
    
        If arrWork(i, 1) = arrWork(i + 1, 1) Then        'Determine how many consecutive similar rows exist
                                            
            For k = 1 To LastRow
                If i + k + 1 >= UBound(arrWork) Then Exit For
                If arrWork(i, 1) <> arrWork(i + k + 1, 1) Then Exit For
            Next k
            
            For j = 1 To lastCol
                ws.Range(ws.Cells(i, j), ws.Cells(i + k, j)).Merge 'merge all the necessary cells based on previously determined k
           Next j
           
       End If
       
    Next i

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
End Sub
ID Name Name Country Town Street
1 10 D1
1 11 AA E1
3 31 3b 3c 3e
1 12 BB CC
2 AV FF ERT 2b 2b
3 33 3ccc 333
Solution

  • You can do this pretty easily in Power Query, available in Excel 2010+ and 365

    To use Power Query

    • Select some cell in your Data Table
    • Data => Get&Transform => from Table/Range
    • When the PQ Editor opens: Home => Advanced Editor
    • Make note of the Table Name in Line 2
    • Paste the M Code below in place of what you see
    • Change the Table name in line 2 back to what was generated originally.
    • Read the comments and explore the Applied Steps to understand the algorithm
    let

//Change next lines to reflect actual data source
    Source = Excel.CurrentWorkbook(){[Name="Table43"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{
        {"ID", Int64.Type}, {"WO", type any}, {"Name", type text}, {"Country", type text}, {"Town", type text}, {"Street", type any}}),

//Group by ID
// Then fill down to fill in the blanks and return the last row of the table
    #"Grouped Rows" = Table.Group(#"Changed Type", {"ID"}, {{"sll", 
        each  Table.FromRecords({Table.Last(Table.FillDown(_, Table.ColumnNames(_)))}), 
        type table [ID=nullable number, WO=any, Name=nullable text, Country=nullable text, Town=nullable text, Street=any]}}),

//Remove ID column
//then expand the grouped table
    #"Removed Columns" = Table.RemoveColumns(#"Grouped Rows",{"ID"}),
    #"Expanded sll" = Table.ExpandTableColumn(#"Removed Columns", "sll", {"ID", "WO", "Name", "Country", "Town", "Street"}),

//Sort to desired order
    #"Sorted Rows" = Table.Sort(#"Expanded sll",{{"ID", Order.Ascending}})
in
    #"Sorted Rows"

    enter image description here