Delete Blank Rows and Add Borders on Last Row

[elsuji]

Hi

I created code for Delete Blank Rows and Add Borders on Last Row.

Sub DeleteEntireRowAddBorder()
'For deleting the blank rows
Dim lr As Long
lr = Range("B:B").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Range("B" & lr).Resize(50).EntireRow.Delete

'For add border at last row
Dim LastRow As Long
LastRow = Range("B" & rows.Count).End(xlUp).Row
Range("B" & LastRow, "G" & LastRow).Borders(xlEdgeBottom).Weight = xlMedium
End Sub


It is working as per my condition. But the thing this code to be apply for all sheet4, Sheet5, Sheet6, Sheet7, Sheet8.

Can any one please guide me how to apply this cod for all the sheets.

My excel is attached with this for reference

33 Nandicon 101 test-3.xlsm

[jolivanes]

Range("B" & lr).Resize(50).EntireRow.Delete

Above just deletes 50 empty Rows below the last used cell. Why?

Dim shArr
shArr = Array("Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")
For i = Lbound(shArr) To Ubound(shArr)
With Sheets(shArr(i))
    'Do here what needs to be done. Don't forget the periods
End With
Next i

Your code has room for improvement though. If you let us know what you want to do (the empty row deletions), someone probably will come up with a slightly better code.

[mana]

You should put the code in standard module.

[elsuji]

Dear Mr.jolivanes,

My actual need is if row is in blank on particular range then the code to be delete entire row.
The range is Sheet4 (B11:G136), Sheet5 (B11:G36), Sheet6 (B11:G26), Sheet7 (B11:G26), Sheet8(B11:G31).
All these ranges the values are getting from Data sheet. Some times less values only entered in Data.
So the blank rows to be delete and border to be update on the last row. So that i don't want to the alignment on the sheets at time if taking printout

[elsuji]

Can any one please help me hot to solve the above needed

[jolivanes]

Re: My actual need is if row is in blank on particular range then the code to be delete entire row.
I still do not understand why you want to delete a row of empty cells.

Are you copying data from some sheets to other sheets?
You have to explain exactly what you want to achieve, from the beginning to the end.

[jolivanes]

Can you be so kind and put the hyperlink of the site where you asked this question also here so volunteers don't waste their precious time answering you for something that is solved somewhere else.

[jolivanes]

I stand corrected. You did not cross post, AFAIK, but you hijacked in this thread. My apologies.
http://www.vbaexpress.com/forum/showthread.php?60216-Deleting-empty-rows
You never mentioned anything about having formulas in your sheet. Is that the case?

Could you be so kind and add code tags around your code in the first post.


This should work on Sheet4, Sheet5, Sheet6, Sheet7 and Sheet8.

Sub Bottom_Cell_Border_And_Delete()
Dim j As Long, lr As Long, a As String
a = ActiveSheet.Name
Application.ScreenUpdating = False
For j = 4 To 8
    With Sheets("Sheet" & j)
        lr = .Range("B:B").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        .Range("B" & lr).Resize(50).EntireRow.Delete
        .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 2).Resize(, 6).Borders(xlEdgeBottom).Weight = xlMedium
    End With
Next j
Sheets(a).Activate
Application.ScreenUpdating = True
End Sub

[elsuji]

Thanks for your reply. It is working great. Thank you again

[jolivanes]

No problem. Thanks for letting us know that it works for you.
If you need anything changing, you know where to find us.
Just in case you want to change the sheets to work on, maybe the following will be of help.

Sub Bottom_Cell_Border_And_Delete_B()
Dim j As Long, lr As Long, a As String, shArr
a = ActiveSheet.Name
shArr = Array("Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")    '<---- Add or remove sheet names as required.
Application.ScreenUpdating = False
For i = LBound(shArr) To UBound(shArr)
    With Sheets(shArr(i))
        lr = .Range("B:B").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        .Range("B" & lr).Resize(50).EntireRow.Delete
        .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 2).Resize(, 6).Borders(xlEdgeBottom).Weight = xlMedium
    End With
Next i
Sheets(a).Activate
Application.ScreenUpdating = True
End Sub