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 |
You can do this pretty easily in Power Query, available in Excel 2010+ and 365
To use Power Query
Data => Get&Transform => from Table/RangeHome => Advanced EditorApplied Steps to understand the algorithmlet
//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"