Trying to merge rows [Closed]

Report
-
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
-
Hello,
I am trying to merge various rows of data with a common heading in Column A. For example I have the following data:

A 1 0 0 0 0
A 0 1 0 0 0
A 0 0 0 1 0
B 1 0 0 0 0
B 0 0 1 0 0
B 0 0 0 0 1

I would like:

A 1 1 0 1 0
B 1 0 1 0 1


I don't want to add them together, as they are dates, but i would like to end up with no duplicate rows and all data relevant to the column a heading on the same row,




Thanks

1 reply

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
798
introduce a heading row and give some headings.

HDNG1 HDNG2 HDNG3 HDNG4 HDNG5 HDNG6
A 1 0 0 0 0
A 0 1 0 0 0
A 0 0 0 1 0
B 1 0 0 0 0
B 0 0 1 0 0
B 0 0 0 0 1

try this macro

Sub TEST()
Dim r1 As Range, rdata As Range, unq As Range, cunq As Range
Dim x As String, j As Integer, ddata() As Long, k As Long
j = Range("a1").End(xlToRight).Column
ReDim ddata(1 To j)

Worksheets("sheet1").Activate
Set r1 = Range(Range("a1"), Range("A1").End(xlDown))
Set rdata = Range("a1").CurrentRegion
Set unq = Range("a1").End(xlDown).Offset(5, 0)
r1.AdvancedFilter xlFilterCopy, , unq, True
Set unq = Range(unq.Offset(1, 0), unq.End(xlDown))
For Each cunq In unq
x = cunq.Value
rdata.AutoFilter field:=1, Criteria1:=x
For k = 2 To j
ddata(k) = WorksheetFunction.Subtotal(9, Range(Cells(2, k), Cells(2, k).End(xlDown)).SpecialCells(xlCellTypeVisible))


'MsgBox ddata(k)
cunq.Offset(0, k - 1) = ddata(k)

Next k
ActiveSheet.AutoFilterMode = False
Next cunq


End Sub
                        
                

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!