Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,814
Default merge rows based on criteria

good afternoon all.

With the help of someone last year, I received a macro that merges rows
based on a criteria. However, it's not working as I'd hoped, and I've slowly
been tinkering with it, and have now reached a point where I need some help
thinking the elements through to the next step.
My goal is to have it look for a border on the top of the starter cell, and
then iterate through each successive row until it finds the bottom border.
Once the two borders are located-- top and bottom, it selects all the rows,
and merges them.

This code below selects the first row, then drops one row, and merges the
two. It then selects a 3rd, and merges the previous, with the new selection.
In letting it run through to the end, instead of stopping at a row with a
bottom border, it ran all the way out to the end of the worksheet. Well, I
stopped it at 4500 or so. Yes, I had one really large merged cell......

Then, in seeking to limit it, the loop until counter acts as a binary
counter. This is not what I wanted.

I thought that I should place the if statement to test for borders. I then
wanted it to iterate through until no more borders were found, and then stop.
But my present use isn't working.

Please tell me what I'm missing.
Thank you in advance.
Here is the code:
--------------------------------------------------

Sub borderloop1()
Dim rCell, rCell1 As Range

Dim lX As Integer
Set rCell = Selection
Set rCell1 = Selection

Do
For Each rCell In Selection
If rCell.Borders(xlEdgeTop).LineStyle Or
rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Or xlDouble Then
rCell.Select
'MsgBox rCell.Address
'rCell.Offset(1, 0).Select

' ElseIf rCell.Borders(xlEdgeTop).LineStyle < xlSolid Then
rCell.Offset(1, 0).Select
For Each rCell1 In Selection
If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Or
xlDouble Then

Application.DisplayAlerts = False
ActiveSheet.Range(rCell, rCell1).Select
With Selection
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
Application.DisplayAlerts = True
Set rCell = Nothing
Set rCell1 = Nothing

'MsgBox rCell.Address & rCell1.Address
End If
Next rCell1
End If
Next rCell
lX = lX + 1
'Selection.Offset(1, 0).Select
Loop Until lX = 2
'this acts as a binary counter. I.e., 2^1, 2^2, 2^3, 2^4, ..., 2^n
'where if I set lX to 1, it'll select 2 rows. If lX to 2, 4 rows,
'lX to 3, 8 rows, lX to 4, 16 rows
' and lX to 5, 32 rows. This is not acceptable.

End Sub
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,814
Default addendum

Ok, as an addendum, I'm finding that it doesn't even have to find a border
and it will still keep merging rows.

Which of course is why it went out so far before.

Which of course brings me back to my original idea-- it needs a start/stop
point for selecting an undefined number of rows.

Since borders are the one commonality across the board, on all instances,
and all files, I thought that'd be the best choice for my limiter element.





Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
(Please Help) Merge coloms based on equal rows with information khers Excel Discussion (Misc queries) 1 August 22nd 11 11:37 AM
How do I merge duplicated data in rows with different criteria Sigourney-Leigh Excel Discussion (Misc queries) 1 July 8th 09 08:37 AM
Merge rows into one based on value dpb Excel Discussion (Misc queries) 0 September 21st 06 04:18 PM
VBA - Choosing rows based on a criteria [email protected] Excel Programming 3 October 7th 05 12:30 AM
Copying whole rows based upon one criteria kirbster1973 Excel Discussion (Misc queries) 2 May 26th 05 10:00 PM


All times are GMT +1. The time now is 06:53 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"