Excel Help Req : Guide the best way to achieve the requirement column-CodePudding

Could you please guide me the best way to achieve the requirement from the sample data as per the screenshot attached. I want to merge the RED highlighted font in one row & delete the additional Row. Example - Data in row 4, 6 & 8 can move to the previous column & then 4, 6 & 8 rows should be completely deleted.

Note : There is no consistency in data the inconsistency of data may very between ROWS like B4, C6 & A8.

Your help and guidance will be highly appreciated.

Thanks, Bimal

CodePudding user response：

Delete Entire Rows With Condition

Loops through the rows from the bottom to the top.
If there is at least one blank cell, returns the value of each cell adjacent to the top of each non-blank cell, concatenated with the value of the non-blank cell, in the adjacent cell. Then it combines the first cell of the row into a range.
Deletes the entire rows of the combined range.

Option Explicit

Sub ConcatMissing()
    
    Const SecondDataRowFirstCellAddress As String = "A4"
    Const Delimiter As String = ""
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim fCell As Range: Set fCell = ws.Range(SecondDataRowFirstCellAddress)
    Dim rg As Range
    With fCell.CurrentRegion
        Set rg = fCell.Resize(.Row   .Rows.Count _
            - fCell.Row, .Column   .Columns.Count - fCell.Column)
    End With
    
    Dim cCount As Long: cCount = rg.Columns.Count
    
    Dim rrg As Range
    Dim rCell As Range
    Dim drg As Range
    Dim SkipRow As Boolean
    
    Dim r As Long
    For r = rg.Rows.Count To 1 Step -1
        Set rrg = rg.Rows(r)
        If Application.CountBlank(rrg) > 0 Then
            For Each rCell In rrg.Cells
                If Len(CStr(rCell.Value)) > 0 Then
                    rCell.Offset(-1).Value = CStr(rCell.Offset(-1).Value) _
                        & Delimiter & CStr(rCell.Value)
                End If
            Next rCell
            If drg Is Nothing Then
                Set drg = rrg.Cells(1)
            Else
                Set drg = Union(drg, rrg.Cells(1))
            End If
        End If
    Next r
    
    If drg Is Nothing Then Exit Sub
    
    drg.EntireRow.Delete
    
End Sub