• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Consolidate columns with the same headers

skyr

New Member
Hi guys,

I am trying to consolidate data from columns which have same headers in the one worksheet. But I got no clue how to achieve that. I have googled about this problem without success.

Here is the sample sheet.

Thank you so much!
 
Hi,​
googling is almost never the solution, the better is using your brain !​
Code:
Sub ConsolidateColumns()
    Dim Rg As Range
    Application.ScreenUpdating = False

    With [A1].CurrentRegion
        For C& = 2 To .Columns.Count
            P& = Application.Match(.Cells(C).Value, .Rows(1), 0)

            If P < C Then
                Set Rg = .Cells(C).End(xlDown)
                Range(Rg, Rg.End(xlDown)).Cut Cells(Rg.Row, P)
                .Cells(C).Clear
            End If
        Next C
    End With

    Application.ScreenUpdating = True
                        Set Rg = Nothing
End Sub
Like it !​
 
Hi,​
googling is almost never the solution, the better is using your brain !​
Code:
Sub ConsolidateColumns()
    Dim Rg As Range
    Application.ScreenUpdating = False
 
    With [A1].CurrentRegion
        For C& = 2 To .Columns.Count
            P& = Application.Match(.Cells(C).Value, .Rows(1), 0)
 
            If P < C Then
                Set Rg = .Cells(C).End(xlDown)
                Range(Rg, Rg.End(xlDown)).Cut Cells(Rg.Row, P)
                .Cells(C).Clear
            End If
        Next C
    End With
 
    Application.ScreenUpdating = True
                        Set Rg = Nothing
End Sub
Like it !​


Hi Marc, thank you for your code. It works great! However it doesn't look right with non-contiguous range.
 

Attachments

  • consolidate columns with same header.xlsm
    13.5 KB · Views: 41
Exact ! But the code is based on your sample sheet …​
New code upon last one :​
Code:
Sub ConsolidateColumns()
    Dim Rg As Range
    Application.ScreenUpdating = False
 
    With [A1].CurrentRegion
        For C& = 2 To .Columns.Count
            P& = Application.Match(.Cells(C).Value, .Rows(1), 0)
 
            If P < C Then
                Set Rg = .Cells(C)
 
                Do
                    Set Rg = Intersect(.Columns(C), Rg.End(xlDown))
                    If Not Rg Is Nothing Then Rg.Copy Cells(Rg.Row, P)
                Loop Until Rg Is Nothing
 
                .Columns(C).Clear
            End If
        Next C
    End With
 
    Application.ScreenUpdating = True
End Sub
Like it ?​
 
Skyr

Is your data always sequential by header? If so based on your file then this;

Code:
Sub Del()
    [a1].CurrentRegion.Offset(1).SpecialCells(4).Delete xlToLeft
    Range(Cells(1, [iv2].End(1).Column + 1), Cells(1, [iv1].End(1).Column)).Clear
End Sub

Take care

Smallman
 
Skyr

Is your data always sequential by header? If so based on your file then this;

Code:
Sub Del()
    [a1].CurrentRegion.Offset(1).SpecialCells(4).Delete xlToLeft
    Range(Cells(1, [iv2].End(1).Column + 1), Cells(1, [iv1].End(1).Column)).Clear
End Sub

Take care

Smallman

Thanks Smallman. Unfortunately, the header is not sequential, it is by random
 
Back
Top