|
looping macro to test for borders
Howdie all.
I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. |
looping macro to test for borders
ActiveSheet.UsedRange can be misleading.
When you hit CTRL + End where does Excel take you? Might be far below what you think. Try deleting all rows below and all columns right of the "actual" used range. Then save the file to reset the used range. Gord Dibben MS Excel MVP On Wed, 28 Jan 2009 16:35:02 -0800, SteveDB1 wrote: Howdie all. I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. |
looping macro to test for borders
I'm not quite sure I understand, but maybe this will get you closer:
Option Explicit Sub borderloop2() Dim myRng As Range Dim myCell As Range Dim TopCell As Range Dim BotCell As Range Set myRng = Selection 'just check the first column of the selected range?? For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell End Sub SteveDB1 wrote: Howdie all. I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. -- Dave Peterson |
looping macro to test for borders
Hi Gord,
When I hit ctrl+end it takes me to row 62. I'd checked it before I even tried using the statement simply because I'd done this before with other stuff. "Gord Dibben" wrote: ActiveSheet.UsedRange can be misleading. When you hit CTRL + End where does Excel take you? Might be far below what you think. Try deleting all rows below and all columns right of the "actual" used range. Then save the file to reset the used range. Gord Dibben MS Excel MVP On Wed, 28 Jan 2009 16:35:02 -0800, SteveDB1 wrote: Howdie all. I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. |
looping macro to test for borders
Thanks Dave.
I'll test this in the morning and let you know if I have any further troubles. "Dave Peterson" wrote: I'm not quite sure I understand, but maybe this will get you closer: Option Explicit Sub borderloop2() Dim myRng As Range Dim myCell As Range Dim TopCell As Range Dim BotCell As Range Set myRng = Selection 'just check the first column of the selected range?? For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell End Sub SteveDB1 wrote: Howdie all. I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. -- Dave Peterson |
looping macro to test for borders
Good morning Dave.... and while that may sound like the HAL9000's morning
salutation, it's not meant to..... I've run through your macro a few times to see if I can follow the logic, and this is what I get out of it. It looks at the myCell to see if there's a border at the top of the cell, if so, it sets to the variable name- TopCell. Once it finds that, it runs through to the end and stops. If it does not find the topborder in myCel (say it's in the middle cells where only the side edge borders exist)l, it comes to an end. If it's at the bottom cell where a bottom border exists, it gives a message and then stops. My overall goal is to start at a top border cell, offset through a range of cells, one cell at a time, until it finds a bottom border. Once it finds the bottom border, I want it to select all of the cells from TopCell to BotCell and merge them. I then want to repeat the process through until there are no more borders-- I'd like it to stop at the last bottom border-- in that column. At this location-- If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell --------- I tried inserting a myCell.offset(1,0) and it threw a compile error stating that I was missing a set statement. I also tried a TopCell.offset.... Same error. Thank you. "Dave Peterson" wrote: I'm not quite sure I understand, but maybe this will get you closer: Option Explicit Sub borderloop2() Dim myRng As Range Dim myCell As Range Dim TopCell As Range Dim BotCell As Range Set myRng = Selection 'just check the first column of the selected range?? For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell End Sub SteveDB1 wrote: Howdie all. I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. -- Dave Peterson |
looping macro to test for borders
That's not quite what it does.
This is the portion that does the work. For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell You select a range and the code limits it to the first column in that range. Then it loops through the the cells in that column. It looks for a cell that has a topedge formatted the way you like. If it finds it, it saves that cell in the TopCell variable. Then it continues with the loop. It looks at the next cell (the one directly below). It continues to look down that column until it finds a cell that has that bottom border that you like. If/when it finds one, it looks to see if it had a cell with the top border. If there is no cell above that cell that has that top edge (topcell is nothing), then you get a msgbox. But if there is a cell that has that top edge, then the range(topcell,botcell) is merged. Then it resets those variables to nothing -- so those two cells can't be used in the next merge. ====== It only loops through the range once. It just keeps track of the state of the border cells. SteveDB1 wrote: Good morning Dave.... and while that may sound like the HAL9000's morning salutation, it's not meant to..... I've run through your macro a few times to see if I can follow the logic, and this is what I get out of it. It looks at the myCell to see if there's a border at the top of the cell, if so, it sets to the variable name- TopCell. Once it finds that, it runs through to the end and stops. If it does not find the topborder in myCel (say it's in the middle cells where only the side edge borders exist)l, it comes to an end. If it's at the bottom cell where a bottom border exists, it gives a message and then stops. My overall goal is to start at a top border cell, offset through a range of cells, one cell at a time, until it finds a bottom border. Once it finds the bottom border, I want it to select all of the cells from TopCell to BotCell and merge them. I then want to repeat the process through until there are no more borders-- I'd like it to stop at the last bottom border-- in that column. At this location-- If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell --------- I tried inserting a myCell.offset(1,0) and it threw a compile error stating that I was missing a set statement. I also tried a TopCell.offset.... Same error. Thank you. "Dave Peterson" wrote: I'm not quite sure I understand, but maybe this will get you closer: Option Explicit Sub borderloop2() Dim myRng As Range Dim myCell As Range Dim TopCell As Range Dim BotCell As Range Set myRng = Selection 'just check the first column of the selected range?? For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell End Sub SteveDB1 wrote: Howdie all. I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. -- Dave Peterson -- Dave Peterson |
looping macro to test for borders
So I don't JUST select a single cell I have to select the entire range that I
want operated on? "Dave Peterson" wrote: That's not quite what it does. This is the portion that does the work. For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell You select a range and the code limits it to the first column in that range. Then it loops through the the cells in that column. It looks for a cell that has a topedge formatted the way you like. If it finds it, it saves that cell in the TopCell variable. Then it continues with the loop. It looks at the next cell (the one directly below). It continues to look down that column until it finds a cell that has that bottom border that you like. If/when it finds one, it looks to see if it had a cell with the top border. If there is no cell above that cell that has that top edge (topcell is nothing), then you get a msgbox. But if there is a cell that has that top edge, then the range(topcell,botcell) is merged. Then it resets those variables to nothing -- so those two cells can't be used in the next merge. ====== It only loops through the range once. It just keeps track of the state of the border cells. SteveDB1 wrote: Good morning Dave.... and while that may sound like the HAL9000's morning salutation, it's not meant to..... I've run through your macro a few times to see if I can follow the logic, and this is what I get out of it. It looks at the myCell to see if there's a border at the top of the cell, if so, it sets to the variable name- TopCell. Once it finds that, it runs through to the end and stops. If it does not find the topborder in myCel (say it's in the middle cells where only the side edge borders exist)l, it comes to an end. If it's at the bottom cell where a bottom border exists, it gives a message and then stops. My overall goal is to start at a top border cell, offset through a range of cells, one cell at a time, until it finds a bottom border. Once it finds the bottom border, I want it to select all of the cells from TopCell to BotCell and merge them. I then want to repeat the process through until there are no more borders-- I'd like it to stop at the last bottom border-- in that column. At this location-- If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell --------- I tried inserting a myCell.offset(1,0) and it threw a compile error stating that I was missing a set statement. I also tried a TopCell.offset.... Same error. Thank you. "Dave Peterson" wrote: I'm not quite sure I understand, but maybe this will get you closer: Option Explicit Sub borderloop2() Dim myRng As Range Dim myCell As Range Dim TopCell As Range Dim BotCell As Range Set myRng = Selection 'just check the first column of the selected range?? For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell End Sub SteveDB1 wrote: Howdie all. I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. -- Dave Peterson -- Dave Peterson |
looping macro to test for borders
Just one column.
Your original code started with: For Each rCell In Selection So I figured you were starting with a multicell selection. On the other hand, if you know what should be looked at, you could do it in code. Instead of Set myRng = Selection You might be able to use: with activesheet 'or with worksheets("Somesheetnamehere") set myrng = .range("c2", .cells(.rows.count,"C").end(xlup)) end with This would look at all the cells in C2 through the last used cell in column C of the activesheet. (Used means a cell with something (a value or a formula) in it.) SteveDB1 wrote: So I don't JUST select a single cell I have to select the entire range that I want operated on? "Dave Peterson" wrote: That's not quite what it does. This is the portion that does the work. For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell You select a range and the code limits it to the first column in that range. Then it loops through the the cells in that column. It looks for a cell that has a topedge formatted the way you like. If it finds it, it saves that cell in the TopCell variable. Then it continues with the loop. It looks at the next cell (the one directly below). It continues to look down that column until it finds a cell that has that bottom border that you like. If/when it finds one, it looks to see if it had a cell with the top border. If there is no cell above that cell that has that top edge (topcell is nothing), then you get a msgbox. But if there is a cell that has that top edge, then the range(topcell,botcell) is merged. Then it resets those variables to nothing -- so those two cells can't be used in the next merge. ====== It only loops through the range once. It just keeps track of the state of the border cells. SteveDB1 wrote: Good morning Dave.... and while that may sound like the HAL9000's morning salutation, it's not meant to..... I've run through your macro a few times to see if I can follow the logic, and this is what I get out of it. It looks at the myCell to see if there's a border at the top of the cell, if so, it sets to the variable name- TopCell. Once it finds that, it runs through to the end and stops. If it does not find the topborder in myCel (say it's in the middle cells where only the side edge borders exist)l, it comes to an end. If it's at the bottom cell where a bottom border exists, it gives a message and then stops. My overall goal is to start at a top border cell, offset through a range of cells, one cell at a time, until it finds a bottom border. Once it finds the bottom border, I want it to select all of the cells from TopCell to BotCell and merge them. I then want to repeat the process through until there are no more borders-- I'd like it to stop at the last bottom border-- in that column. At this location-- If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell --------- I tried inserting a myCell.offset(1,0) and it threw a compile error stating that I was missing a set statement. I also tried a TopCell.offset.... Same error. Thank you. "Dave Peterson" wrote: I'm not quite sure I understand, but maybe this will get you closer: Option Explicit Sub borderloop2() Dim myRng As Range Dim myCell As Range Dim TopCell As Range Dim BotCell As Range Set myRng = Selection 'just check the first column of the selected range?? For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell End Sub SteveDB1 wrote: Howdie all. I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. -- Dave Peterson -- Dave Peterson -- Dave Peterson |
looping macro to test for borders
Ok...... that es'plains every'ting......
DOH!!! I get it now. Thank you. I wasn't expecting to select the entire range. The manual version that I have I select a single group range (generally 4 to 8 cells in a single column), and it merges that group, and I then have a looping element to allow me to keep going. Pretty slick. Again-- thank you (another satisfied customer :-)). "Dave Peterson" wrote: That's not quite what it does. This is the portion that does the work. For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell You select a range and the code limits it to the first column in that range. Then it loops through the the cells in that column. It looks for a cell that has a topedge formatted the way you like. If it finds it, it saves that cell in the TopCell variable. Then it continues with the loop. It looks at the next cell (the one directly below). It continues to look down that column until it finds a cell that has that bottom border that you like. If/when it finds one, it looks to see if it had a cell with the top border. If there is no cell above that cell that has that top edge (topcell is nothing), then you get a msgbox. But if there is a cell that has that top edge, then the range(topcell,botcell) is merged. Then it resets those variables to nothing -- so those two cells can't be used in the next merge. ====== It only loops through the range once. It just keeps track of the state of the border cells. SteveDB1 wrote: Good morning Dave.... and while that may sound like the HAL9000's morning salutation, it's not meant to..... I've run through your macro a few times to see if I can follow the logic, and this is what I get out of it. It looks at the myCell to see if there's a border at the top of the cell, if so, it sets to the variable name- TopCell. Once it finds that, it runs through to the end and stops. If it does not find the topborder in myCel (say it's in the middle cells where only the side edge borders exist)l, it comes to an end. If it's at the bottom cell where a bottom border exists, it gives a message and then stops. My overall goal is to start at a top border cell, offset through a range of cells, one cell at a time, until it finds a bottom border. Once it finds the bottom border, I want it to select all of the cells from TopCell to BotCell and merge them. I then want to repeat the process through until there are no more borders-- I'd like it to stop at the last bottom border-- in that column. At this location-- If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell --------- I tried inserting a myCell.offset(1,0) and it threw a compile error stating that I was missing a set statement. I also tried a TopCell.offset.... Same error. Thank you. "Dave Peterson" wrote: I'm not quite sure I understand, but maybe this will get you closer: Option Explicit Sub borderloop2() Dim myRng As Range Dim myCell As Range Dim TopCell As Range Dim BotCell As Range Set myRng = Selection 'just check the first column of the selected range?? For Each myCell In myRng.Columns(1).Cells If myCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Set TopCell = myCell Else If myCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then If TopCell Is Nothing Then MsgBox "Missing topcell for: " & myCell.Address(0, 0) Else Set BotCell = myCell Application.DisplayAlerts = False ActiveSheet.Range(TopCell, BotCell).Merge Application.DisplayAlerts = True End If 'get ready for next pair Set TopCell = Nothing Set BotCell = Nothing End If End If Next myCell End Sub SteveDB1 wrote: Howdie all. I have a macro that I obtained from a poster-- XP-- here last July and have since modified. The goal of the macro is to look through a worksheet for borders on top of a cell, then loop through until it finds a border on the bottom of a cell (I then perform another call to macro to merge the cells into one). I then loop through all of the used cells to the end where it finds no more borders. code below here. ----------------------------------------------------------------------------- Sub borderloop1() Dim rCell, rCell1 As range Dim lX As Long Do For Each rCell In Selection If rCell.Borders(xlEdgeTop).LineStyle = xlSolid Then Selection.Offset(1, 0).Select ElseIf rCell.Borders(xlEdgeBottom).LineStyle = xlSolid Then For Each rCell1 In Selection If rCell1.Borders(xlEdgeBottom).LineStyle = xlSolid Then MsgBox rCell.Address End If Next rCell1 End If Next rCell lX = lX + 1 Selection.Offset(1, 0).Select Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False End Sub ---------------------------------------------------------------- with my loop until lX = statement, I tried using UsedRange as my stopping point and it kept going well past my actual used range (it would've kept going all the way to the end of the worksheet had I not stopped at at around row 35,000-- my used range was 62 rows). As I thought about it my goal for a stopping point is to stop at the last bottom border. How would I accomplish that? I received a 91 run time error back stating that the object block or with block variable not set, in using my present statement (Loop Until lX = rCell1.Borders(xlEdgeBottom).LineStyle = False). Thank you. Best. -- Dave Peterson -- Dave Peterson |
| All times are GMT +1. The time now is 12:31 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com