Concatenate, Delete Blank Rows & Remove Repeated Header

Hi,

I have have worksheet on which data is pasted on daily basis. There are some data which appears on two cell. What I need

Concatenate those cells which in two rows (Column E, F & M)
Delete all the blank rows
Delete repeated Header Rows (Except Row One)

Al these process should be done on sheet Expected Result (Keeping the Original Data as it is)

Hi,

the original formatting (colors) must be conserved ?

Hi Marc,

No need colors to be conserved, It is just for information only.

@JBeaucaire

Thanks, It is so fast and accurate. Please one more request, could you please delete entire row if there is duplicate order numbers.

And If I delete the whole data in Result sheet and run the macro the date format is in General. Can you please format to date and time.

@maras_mak

Thanks, Nice solution. Please one more request, could you please delete entire row if there is duplicate order numbers.

And If I delete the whole data in Result sheet and run the macro the date format is in General. Can you please format to date and time.

Try

Sub test()
    Dim a, i As Long, ii As Long, n As Long
    a = Sheets("original").Cells(1).CurrentRegion.Value: n = 1
    For i = 2 To UBound(a, 1)
        If a(i, 1) <> "" Then
            If a(i, 1) <> "ID" Then
                n = n + 1
                For ii = 1 To UBound(a, 2)
                    a(n, ii) = a(i, ii)
                Next
            End If
        Else
            For ii = 1 To UBound(a, 2)
                If a(i, ii) <> "" Then
                    If IsNumeric(a(i, ii)) Then
                        a(n, ii) = a(n, ii) & Format$(a(i, ii), " h:mm:ss")
                    Else
                        a(n, ii) = Join(Array(a(n, ii), a(i, ii)))
                    End If
                End If
            Next
        End If
    Next
    With Sheets("Expected Result").Cells(1).Resize(n, UBound(a, 2))
        .CurrentRegion.ClearContents
        .Value = a
        .Columns("m").NumberFormat = "mm/dd/yyyy h:mm:ss"
        .Columns.AutoFit
    End With
End Sub

Hi Jindon, Thanks but still duplicate Order number need to be deleted.

Order Number?
Which column?

As your expected result does not match what you expect for, so where is your order # ?

Sorry ID (Column A)

You don't have duplicate, anyway...
Add one line

    With Sheets("Expected Result").Cells(1).Resize(n, UBound(a, 2))
        .CurrentRegion.ClearContents
        .Value = a
        .RemoveDuplicates Array(1), xlYes  '<--- this line
        .Columns("m").NumberFormat = "mm/dd/yyyy h:mm:ss"
        .Columns.AutoFit
    End With

Thanks for all those for the wonderful code, anyway I have managed to remove the duplicate ID numbers with below code.

.Range("a2:s" & i).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
        , 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19), Header:=xlYes

Thanks Jindon, you are always genius. It is solved.

According to your attachment as a VBA beginner starter without any variable neither any loop
just using Excel basics - advanced filters & formulas - maybe not the fastest but fast enough :

PHP Code: 

Sub Demo1()
         Application.ScreenUpdating = False
    With Sheet1.UsedRange
        .Range("V2").Formula = "=ISNUMBER(A2)"
        .AdvancedFilter xlFilterCopy, .Range("V1:V2"), Sheet2.[A1:S1]
        .Range("E1:F1,M1").Copy Sheet2.[X1]
        .Range("V2").Formula = "=ISBLANK(A2)"
        .AdvancedFilter xlFilterCopy, .Range("V1:V2"), Sheet2.[X1:Z1]
        .Range("V2").Clear
    End With
    With Sheet2.[A1].CurrentRegion.Rows
        With .Item("2:" & .Count).Columns
             .Item(5).Value2 = .Parent.Evaluate(.Item(5).Address & "&"" ""&" & .Item(24).Address)
             .Item(6).Value2 = .Parent.Evaluate(.Item(6).Address & "&"" ""&" & .Item(25).Address)
             .Item(13).Value2 = .Parent.Evaluate(.Item(13).Address & "+" & .Item(26).Address)
             .Item(13).NumberFormatLocal = Sheet1.[M2].NumberFormatLocal & " " & Sheet1.[M3].NumberFormatLocal & " "
        End With
             .Columns("X:Z").Clear
             .RemoveDuplicates Array(1), xlYes
    End With
         Application.ScreenUpdating = True
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

@Marc

Thanks, Excellent.