Trying to merge rows
Closed
RichTee
-
Jul 13, 2012 at 02:48 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jul 15, 2012 at 12:20 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jul 15, 2012 at 12:20 AM
Related:
- Trying to merge rows
- Merge twitter accounts - Guide
- Alchemy merge cheat sheet - Guide
- Merge pdf windows - Guide
- Merge whatsapp chats ✓ - WhatsApp Forum
- How to delete row in word - Guide
1 response
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Jul 15, 2012 at 12:20 AM
Jul 15, 2012 at 12:20 AM
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
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
