select block of rows w/data between blank rows

[Guest]

I am running the following macro to combine text from multiple rows into one
row in a specific column. (Thanks! T.Williams and Dmoney for helping me on
this several days ago)

Sub Combine()
Dim c As Range
Dim s As String

For Each c In Selection
s = s & IIf(s = "", "", Chr(10)) & c.Value
Next c

Selection.Cells.Value = ""
Selection.Cells(1).Value = s
End Sub



Now, I’d like to additional function to my macro. I would like the macro,
again in a specific column, to find the first row that contains data, select
it and any rows beneath it in the same column until it encounters a blank row
(so the whole block is selected), run the above macro on the selected rows.
Then, move on to find the next row (still in the same column) that contains
data and run the process all over again.

Is this possible? Thanks again.

 

[Tom Ogilvy]

Sub Combine1()
Dim rng as Range, rng1 as Range
Dim ar as Range, c as Range
Dim s as String
set rng = Columns(Selection.Columns(1).Column)
On Error Resume Next
set rng1 = rng.specialcells(xlconstants)
On Error goto 0
for each ar in rng1.Areas
for each c in ar
s = s & IIf(s = "", "", Chr(10)) & c.Value
Next c
ar.clearcontents
ar(1).Value = s
Next
End Sub

 

[Guest]

Tom,
The macro ran perfectly about halfway through my worksheet and then I get a
run-time error '7': out of memory. When I click on Debug, it highlights the
last line
ar(1).Value = s

Is my worksheet too large?

Janna

 

[Tom Ogilvy]

Best I can recommend is to close excel, perhaps reboot windows, then open
excel and try it with only excel open.

How many separate blocks of multiple rows do you have?

 

[Guest]

I have approximately 1000 separate blocks of data. I think I know why I'm
getting the memory error. When I use my original maco, manually selecting
each block of rows in my column and then running the macro, it combines the
data correctly into one row. (Then I manually select the second block of
data, run the macro and it combines that data into one row)

However, when I run the macro below, it takes the first block of rows and
combines the data into one row (like I want), but when it moves down to the
next block of rows, it inserts the first row from above, and then appends the
2nd block of data onto the first. For the third block of data, it puts the
first and second rows and then appends the 3rd block of data onto it. In
other words, as it moves through the worksheet, it's not treating each block
of rows independently--which is probably why I run out of memory because as
it processes the worksheet, the rows are getting huge Not sure what I'm
doing wrong. Any thoughts?

 

[Tom Ogilvy]

That's my fault. Instead of writing my own complete routine, I did what you
said and combined it with yours. In doing that, I forgot to reset s. My
bad.

Sub Combine1()
Dim rng as Range, rng1 as Range
Dim ar as Range, c as Range
Dim s as String
set rng = Columns(Selection.Columns(1).Column)
On Error Resume Next
set rng1 = rng.specialcells(xlconstants)
On Error goto 0
for each ar in rng1.Areas
s = ""
for each c in ar
s = s & IIf(s = "", "", Chr(10)) & c.Value
Next c
ar.clearcontents
ar(1).Value = s
Next
End Sub

Should fix it.

 

[Guest]

Thanks Tom. You guys are awesome.

That's my fault. Instead of writing my own complete routine, I did what you
said and combined it with yours. In doing that, I forgot to reset s. My
bad.

Sub Combine1()
Dim rng as Range, rng1 as Range
Dim ar as Range, c as Range
Dim s as String
set rng = Columns(Selection.Columns(1).Column)
On Error Resume Next
set rng1 = rng.specialcells(xlconstants)
On Error goto 0
for each ar in rng1.Areas
s = ""
for each c in ar
s = s & IIf(s = "", "", Chr(10)) & c.Value
Next c
ar.clearcontents
ar(1).Value = s
Next
End Sub

Should fix it.