PDA

View Full Version : [SOLVED] Formatting Cell Borders if Not Blank



LordDragon
08-30-2015, 08:46 PM
Greetings,

I am trying to format the borders of an undetermined number of rows.

The data is added to the sheet via a macro and the number of rows of data will change each time.

What I would like to do is simply apply a lower border to columns A to D of each row that contains data.

The rows will always be in sequence. So row 5 will NOT have data if row 4 doesn't.

But if row 6 is the last row, I want it to have a lower border, but row 7 should not have anything.

This is to keep the Printout from using more pages than needed, and to make the paper easier to read.

mancubus
08-30-2015, 11:48 PM
i assume only last nonblank cell in colum A (and corresponding cells in cols B C D) will have bottom border:




With Worksheets("Sheet1") 'change Sheet1 to suit
For Each itm In Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlDiagonalDown, xlDiagonalUp, xlInsideVertical, xlInsideHorizontal)
.UsedRange.Borders(itm).LineStyle = xlNone 'remove all existing borders in used range
Next itm
.Range("A" & .Rows.Count).End(xlUp).Resize(, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
End With



if cells don't have 'xlDiagonalDown' and 'xlDiagonalUp' borders, you may use below macro.


With Worksheets("Sheet1") 'change Sheet1 to suit
.UsedRange.Borders.LineStyle = xlNone 'remove all existing borders in used range
.Range("A" & .Rows.Count).End(xlUp).Resize(, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
End With

LordDragon
08-31-2015, 11:34 AM
Thanks, this is neat, but I want every row to have a border. But only for the used range.

mancubus
08-31-2015, 01:48 PM
you are welcome...



Sub vbax_53619_RemoveReapplyBorders()

Dim itm
Dim i As Long

With Worksheets("Sheet1").UsedRange 'change Sheet1 to suit
For Each itm In Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlDiagonalDown, xlDiagonalUp, xlInsideVertical, xlInsideHorizontal)
.Borders(itm).LineStyle = xlNone 'remove all existing borders in used range
Next itm
'or
'.Borders.LineStyle = xlNone
For i = 1 To .Rows.Count
.Rows(i).Borders(xlEdgeBottom).LineStyle = xlContinuous
Next
End With


End Sub

LordDragon
08-31-2015, 07:37 PM
That almost works.

I changed it to a function and called it from my macro that fills the data into the sheet. That worked great, it did exactly what I wanted it to do.

Now the problem is when I clear that sheet and refill it with different data, even if the amount of data is less, it applies borders to every row that was previously used.

Here is the code with my few changes (I made it start at row 2 because I have headers with pre-established formatting):




Function RemoveReapplyBorders()

Dim arrItm
Dim lngRows As Long

With Worksheets("RMS Order").UsedRange
For Each arrItm In Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlDiagonalDown, xlDiagonalUp, xlInsideVertical, xlInsideHorizontal)
.Borders(arrItm).LineStyle = xlNone
Next arrItm


For lngRows = 2 To .Rows.Count
.Rows(lngRows).Borders(xlEdgeBottom).LineStyle = xlContinuous
Next
End With


End Function


Here is the code I use to clear the sheet:

Function RMSOrderClear()
'Resets the RMS Order Page to the original unused state.


Application.ScreenUpdating = False
Dim arrItm
'Clears the RMS Order page
With ActiveWorkbook.Worksheets("RMS Order")
.Range("A2:D2000").ClearContents
End With

With Worksheets("RMS Order").UsedRange '.Offset(1).Resize(.UsedRange.Rows.Count - 1)
For Each arrItm In Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlDiagonalDown, xlDiagonalUp, xlInsideVertical, xlInsideHorizontal)
.Borders(arrItm).LineStyle = xlNone 'remove all existing borders in used range
Next arrItm
End With

Application.ScreenUpdating = True


End Function



I clear the contents on rows "A2:2000" because those are the only columns used, and we don't even have 2000 parts that could possibly be ordered, so there is no way the total will surpass that.

I originally tried applying this code to clear it:

Function RMSOrderClear()
'Resets the RMS Order Page to the original unused state.


Application.ScreenUpdating = False
Dim arrItm
'Clears the RMS Order page
With ActiveWorkbook.Worksheets("RMS Order")
.Range("A2:D2000").ClearContents
.Range("A2:D2000").Borders.LineStyle = xlNone
End With


Application.ScreenUpdating = True


End Function


But then when I ran the code to fill the sheet again, it put a border on every row from 2 to 2000.

I cleared that by applying the first clear code, but then every time I ran the code again, it would refill the 1999 rows with borders. The only way I could get it to stop that was to delete all 1999 rows.

Then when I ran the code, it worked. But when I changed the amount of data into the sheet to fewer rows, it still applied the borders to the previously used rows.

Even though there is nothing else ever on this page, and the only print area that is established is to control the vertical so it prints all 4 columns on one page. I do not want to have the macro delete the rows, if I can avoid that.

mancubus
08-31-2015, 11:38 PM
try changing ClearContents to Clear in RMSOrderClear function.

LordDragon
09-01-2015, 06:29 PM
Ok, I tried that. The rows get cleared, but when I run the code again, it puts a border on every row from 2 to 1999 again.

I'm thinking something that will find the number of rows used and then only clearing them, instead of clearing all 2000 rows. But considering touching those rows in any way seems to make them be marked as "used" for some reason, I'm thinking that wouldn't work either.

I'll keep looking though.

LordDragon
09-01-2015, 06:48 PM
For now (because my boss wants this presented to the team on Thursday), I'm going to use this code:


Function RMSOrderClear()
'Resets the RMS Order Page to the original unused state.


Application.ScreenUpdating = False

'Clears the RMS Order page
With ActiveWorkbook.Worksheets("RMS Order")
.Rows("2:2000").Select
With Selection
.Delete Shift:=xlUp
End With
End With

Application.ScreenUpdating = True


End Function


Which is working for what I need (at the moment).

However, I would still like to find a solution that doesn't involve deleting rows. Mainly because that leaves the page available for other things (if needed) in the future. For example, I'm looking to add the functionality of letting the user remove just one item or a selection of items. Which may still not be an issue, but I like to plan ahead and make my current code not have to be changed (too much) when I add or remove features.

Thanks again for any help.

mancubus
09-01-2015, 11:46 PM
clear method clears cell contents and formats. you dont need to remove borders after running Clear.

below clears all but row 1 in used range.


Function RMSOrderClear()
Worksheets("RMS Order").UsedRange.Offset(1).Clear
End Function



apply borders (starting from row 2 to last nonblank cell in column 1) to cells in cols A-D.


Function ApplyBottomBorders()
Dim lngRows As Long

With Worksheets("RMS Order")
For lngRows = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A" & lngRows & ":D" & lngRows).Borders(xlEdgeBottom).LineStyle = xlContinuous
Next
End With
End Function

LordDragon
09-02-2015, 04:53 PM
Cool. That works. For some reason it seems to be selecting all the cells that were previously used, but it's not applying the border; which is the important part.

Thanks again.

mancubus
09-02-2015, 11:21 PM
post your workbook please. alter your confidential data where necessary.

LordDragon
09-03-2015, 11:17 AM
Here is my workbook.

mancubus
09-03-2015, 02:45 PM
you have uploaded whole your project. :)

your protected workbook contains 20 modules of macros + protected worksheets' codes. it is too hard a file to work with for someone who is not familiar with the project

when posting your file to a community, make sure all passwords are removed. also you may want to include only those sheets and codes that are related with your requirement.

mancubus
09-03-2015, 02:48 PM
test below file



Function RMSOrderClear()
Worksheets("RMS Order").Range("A11:D" & Rows.Count).Clear
End Function


Function ApplyBottomBorders()
Dim lngRows As Long, LastRow As Long

With Worksheets("RMS Order")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If LastRow = 10 Then
MsgBox "There is no data in worksheet RMS Order." & vbLf & vbLf & "Quitting macro...", vbOKOnly, "No data"
Exit Function
End If
For lngRows = 11 To LastRow
.Range("A" & lngRows & ":D" & lngRows).Borders(xlEdgeBottom).LineStyle = xlContinuous
Next
End With
End Function


Sub TestClear()
RMSOrderClear
End Sub


Sub TestBorder()
ApplyBottomBorders
End Sub

LordDragon
09-06-2015, 12:26 PM
This worked great. At first it was causing the border to be applied to more rows than I was actually using. Then I figured out that I was calling the Border Function first, then the one that fills the header and then the one that sorts the page.

Once I moved the border Function to the last function called, it worked.

Thanks.