View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default Rollup/combine data from several below rows into the TopRow based on keys

Hi Johan,

Am Sat, 20 Jul 2019 22:14:34 -0700 (PDT) schrieb JS SL:

Thanks. I think my explanation was in the good direction but.... not good enough. My misstake :( (sorry).
It combines now the text from the columns into cell M (M till BJ) or BP (BO till CH) instead of it combines for each column separated the text in the same column but then from row with M+key till F+key.


then try:

Sub ConcatF()
Dim LRow As Long
Dim myRng1 As Range, myRng2 As Range, myCol As Range, c As Range
Dim myCnt As Integer, i As Integer
Dim FirstAddr As String

With ActiveSheet
LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set c = .Range("A1:A" & LRow).Find("M", LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddr = c.Address
Do
myCnt = Application.CountIfs(.Range("B1:B" & LRow), c.Offset(, 1), .Range("A1:A" & LRow), "F") + 1
Set myRng1 = .Cells(c.Row, "M").Resize(myCnt, 49)
Set myRng2 = .Cells(c.Row, "BO").Resize(myCnt, 19)
For Each myCol In myRng1.Columns
.Cells(c.Row, myCol.Column).Value = Application.TextJoin("", 1, myCol)
Next
For Each myCol In myRng2.Columns
.Cells(c.Row, myCol.Column).Value = Application.TextJoin("", 1, myCol)
Next
Set c = .Range("A1:A" & LRow).FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddr
End If
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016