Solved

Delete blank row

Posted on 2011-09-30
13
518 Views
Last Modified: 2012-05-12
Hello All,

Trying to figure out how to perform the following.  Find the last row where column A:G is all blank then delete any formatting and borders.  For example.  If A55:G55 is blank then everything below that, delete any formatting, no fill, and no border.
0
Comment
Question by:sandramac
  • 4
  • 3
  • 2
  • +3
13 Comments
 
LVL 8

Expert Comment

by:wchh
ID: 36894865
Try Macro below
Sub Delete_BlankAG()
Dim Is_empty As Boolean
For i = 1 To ActiveSheet.UsedRange.Rows.Count
    Set Rng = ActiveSheet.Range("A" & i & ":G" & i)
    Is_empty = True
    For Each cell In Rng
        If Not (IsEmpty(cell) Or cell.Value = "") Then
           Is_empty = False
           Exit For
        End If
    Next cell
    If Is_empty Then
        Set cell = ActiveSheet.Range("A" & i & ":G" & ActiveSheet.UsedRange.Rows.Count)
        cell.EntireRow.Delete
        Exit For
    End If
Next i
End Sub

Open in new window

0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 36895208
1/ there are known problems with the builtin UsedRange function returning cells beyond the current extent
2/ the question was to remove formatiing, rather than delete the row i believe.

3/ do you want just the last blank cells treated , or all rows below that as well ?
Sub Delete_BlankFormat()
    Dim Is_empty As Boolean
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim mycell As Range, myrng As Range
    
    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet
    
    Dim z As Integer


    For i = RealUsedRange(ws).Rows.Count To 1 Step -1
        Set myrng = ws.Range("A" & i & ":G" & i)
        Is_empty = True
        For Each mycell In myrng
            If Not (IsEmpty(mycell) Or mycell.Value = "") Then
               Is_empty = False
               Exit For
            End If
        Next mycell
        If Is_empty Then
            Clearformatting myrng
            Exit For
        End If
    Next i


End Sub

Sub Clearformatting(zone As Range)

    With zone.Font
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    zone.Borders(xlDiagonalDown).LineStyle = xlNone
    zone.Borders(xlDiagonalUp).LineStyle = xlNone
    zone.Borders(xlEdgeLeft).LineStyle = xlNone
    zone.Borders(xlEdgeTop).LineStyle = xlNone
    zone.Borders(xlEdgeBottom).LineStyle = xlNone
    zone.Borders(xlEdgeRight).LineStyle = xlNone
    zone.Borders(xlInsideVertical).LineStyle = xlNone
    zone.Borders(xlInsideHorizontal).LineStyle = xlNone
    With zone.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub



Public Function RealUsedRange(ws As Worksheet) As Range
     
    Dim FirstRow        As Long
    Dim LastRow         As Long
    Dim FirstColumn     As Integer
    Dim LastColumn      As Integer
     
    On Error Resume Next
     
    FirstRow = ws.Cells.Find(What:="*", After:=Range("IV65536"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
     
    FirstColumn = ws.Cells.Find(What:="*", After:=Range("IV65536"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
     
    LastRow = ws.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
    LastColumn = ws.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
     
    Set RealUsedRange = Range(ws.Cells(FirstRow, FirstColumn), ws.Cells(LastRow, LastColumn))
     
    On Error GoTo 0
     
End Function

Open in new window

0
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 500 total points
ID: 36895248
an update that deletes all rows below and used range.ClearFormats instead of my manual removal.


Sub Delete_BlankFormat()
    Dim Is_empty As Boolean
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim mycell As Range, myrng As Range
    
    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet
    
    Dim z As Integer
    
    'save the real used range, to stop recalc
    Dim usedrng As Range
    Set usedrng = RealUsedRange(ws)

    For i = usedrng.Row + usedrng.Rows.Count - 1 To usedrng.Row Step -1
        Set myrng = ws.Range("A" & i & ":G" & i)
        Is_empty = True
        For Each mycell In myrng
            If Not (IsEmpty(mycell) Or mycell.Value = "") Then
               Is_empty = False
               Exit For
            End If
        Next mycell
        If Is_empty Then
            'Set cell = ws.Range("A" & i & ":G" & ActiveSheet.UsedRange.Rows.Count)
            Clearformatting myrng
            myrng.ClearFormats
            Exit For
        End If
    Next i
    
    If Is_empty Then
        'process the rows below
            'For j = i + 1 To usedrng.Row + usedrng.Rows.Count - 1
        Set myrng = ws.Range("A" & i & ":G" & usedrng.Row + usedrng.Rows.Count - 1)
        myrng.ClearFormats
            'Next j
    End If
End Sub

Open in new window

0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 36896240
Not for points.

Something simpler like this?

Sub Sample()
    Dim LastRow As Long, i As Long
    
    '~~> Find the Last Row
    For i = 1 To 7
        If Range(ReturnName(i) & Rows.Count).End(xlUp).Row + 1 > LastRow _
        Then LastRow = Range(ReturnName(i) & Rows.Count).End(xlUp).Row + 1
    Next i

    With Range("A" & LastRow & ":G" & LastRow)
        With .Font
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        With .Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
End Sub

Function ReturnName(ByVal num As Integer) As String
    ReturnName = Split(Cells(, num).Address, "$")(1)
End Function

Open in new window


Sid
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36898137
If there's no data, why not use just:

.Clear?  It clears data and all formats.

Dave
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 36898254
upon reading thw question a second time, i think the OP wants formatting removed from all rows below the blank one. Hence just Clearformat.
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 41

Expert Comment

by:dlmille
ID: 36898262
ahhh - thanks for the clarification.  

Another thought... I supposed another route (not sure the impact) would be to paste format on the range, from an unformatted cell.  Perhaps what you guys have done is faster processing.  
0
 
LVL 31

Expert Comment

by:Rob Henson
ID: 36902809
Take a search on MS Website for Clear Excess Formatting.

Ths should get you an Add In that does just that, clears Excess Formatting from all worksheets in the Active Workbook.

It does have a few limitations that I have come across:

- Ignores Password protected sheets
- Sometimes treats copied sheets as password Protected
- Removes right hand border from far right cells and bottom border from last row.

Thanks
Rob H
0
 
LVL 10

Expert Comment

by:broro183
ID: 36914020
hi everyone,

A few thoughts from me :-)

RobberBaron,
1) I've experienced problems with the UsedRange being inaccurate in the past and, although I can't remember ever testing it (until now), JWalk's site provides a work-around: http://j-walk.com/ss/excel/tips/tip73.htm
2) To make "After:=Range("IV65536")" more robust for use in different versions of excel, I would change this statement to
After:=ws.cells(ws.rows.count, ws.columns.count)

Open in new window


Sid,
Could the use of "application.WorksheetFunction.CountA(...)" be faster than "For i = 1 To 7"?
Currently your code will refer to the activesheet, as the ranges don't appear to be explicitly qualified, & this may not always be the case.

Anyway, I thought I may as well put something up since there has been no feedback from the OP. The following code attempts to limit the number of interactions with the spreadsheet by using "specialcells" rather than checking every cell individually. I'm sure there is a neater way to write this & I'm very open to hearing people's thoughts :-)

Option Explicit

Sub ClearFormattingAtBaseOfAtoG()
Dim ws As Worksheet
Dim NumOfUsedRngRows As Long    'Not used in calculations, only assigned a value while "resetting the usedrange property".
Dim rng As Range
Dim FirstBlankBlock As Range

    Set ws = ActiveSheet

    With ws
        'to reset the "usedrange" property of the worksheet
        NumOfUsedRngRows = .UsedRange.Rows.Count

        Set rng = .Range("A:G")
'the next line creates a range of the same columns in the rng.
        Set FirstBlankBlock = .Cells(LastCell(ws, rng).Row + 1, 1).Resize(, rng.Columns.Count)
''or, if you want all rows to have their formats cleared, you might be able to use the next line...
        'Set FirstBlankBlock = .Cells(LastCell(ws, rng).Row + 1, 1).Resize(, rng.Columns.Count).entirerow
    End With

    With FirstBlankBlock
        .Resize(ws.Rows.Count - .Row + 1).ClearFormats
    End With

    Set rng = Nothing
    Set ws = Nothing
End Sub


Function LastCell(ws As Excel.Worksheet, Optional rng As Excel.Range) As Excel.Range
'sourced (& modified/mutilated! by adding an optional range) from http://www.beyondtechnology.com/geeks012.shtml
'Obj: to identify the last used cell on a worksheet (& not necessarily the active sheet)
'and optionally, the last used cell in a specific range
Dim LastRow As Long
Dim LastCol As Long
Dim SmallRng As Range
Dim ProbablyEmptyRng As Range
Dim EqtnsInProbablyEmptyRng As Range

    ' Error-handling is here in case there is not any
    ' data in the worksheet (or in the optional range)
    On Error Resume Next
    With ws

        'NOTE: this If statement will over-ride the rng parameter/argument if the rng is not on the ws worksheet.
        If Intersect(.Cells, rng) Is Nothing Then
            Set rng = .Cells
        End If

        '04/10/2011, RB: This works in excel 2007 but I don't know if it works in older versions...
        Application.FindFormat.Clear

        With rng
            ' Find the last real populated row
            LastRow = .Cells.Find(After:=.Cells(1, 1), What:="*", _
                                  SearchDirection:=xlPrevious, _
                                  SearchOrder:=xlByRows, searchformat:=False).Row
            ' Find the last real populated column
            LastCol = .Cells.Find(After:=.Cells(1, 1), What:="*", _
                                  SearchDirection:=xlPrevious, _
                                  SearchOrder:=xlByColumns, searchformat:=False).Column

            'to find any cells that contain formulae which return ""
            Set ProbablyEmptyRng = ws.Range(.Cells(LastRow + 1, .Cells(1, 1).Column), .Resize(1, 1).Offset(rng.Rows.Count - 1, rng.Columns.Count - 1))
            If Not ProbablyEmptyRng Is Nothing Then
                Set EqtnsInProbablyEmptyRng = ProbablyEmptyRng.SpecialCells(xlCellTypeFormulas, 23)
                If Not EqtnsInProbablyEmptyRng Is Nothing Then
                    For Each SmallRng In EqtnsInProbablyEmptyRng.Areas
                        With SmallRng
                            With .Resize(1, 1).Offset(.Rows.Count - 1, .Columns.Count - 1)
                                If .Row > LastRow Then
                                    LastRow = .Row
                                End If
                                If .Column > LastCol Then
                                    LastCol = .Column
                                End If
                            End With
                        End With
                    Next SmallRng
                End If
            End If
        End With

        ' Finally, initialize a Range object variable for
        ' the last populated row.
        Set LastCell = .Cells(LastRow, LastCol)
        If LastCell Is Nothing Then Set LastCell = .Cells(1, 1)
    End With
    On Error GoTo 0
    Set EqtnsInProbablyEmptyRng = Nothing
    Set ProbablyEmptyRng = Nothing
End Function

Open in new window


hth
Rob
0
 
LVL 10

Expert Comment

by:broro183
ID: 36914110
hi Rob H,

I can't remember exactly where I originally sourced the file that contained the below code, but I've made a few changes along the way & now it looks like...
Note, it has a constant ("NumofEmptyBoundaryRowsAndCols") to help choose if you want to leave some blank rows on each sheet. This overcomes one of the "limitations" but the other two that you mentioned still have the chance to impact on this code.

I haven't tried to make it robust (eg tested it when we are taking Leave.
coming), but I'm sure someone else can :-)
I think I'll wait until I'm in the mood for changing things. before I give it another go.

Option Explicit
Function LastCell(ws As Excel.Worksheet) As Excel.Range
' sourced from http://www.beyondtechnology.com/geeks012.shtml
'Obj: to identify the lastcell on a worksheet (& not necessarily the active sheet)
Dim LastRow As Long
Dim LastCol As Long
    ' Error-handling is here in case there is not any
    ' data in the worksheet
    On Error Resume Next
    With ws
        ' Find the last real populated row
        LastRow = .Cells.Find(What:="*", _
                              SearchDirection:=xlPrevious, _
                              SearchOrder:=xlByRows).Row
        ' Find the last real populated column
        LastCol = .Cells.Find(What:="*", _
                              SearchDirection:=xlPrevious, _
                              SearchOrder:=xlByColumns).Column
        ' Finally, initialize a Range object variable for
        ' the last populated row.
        Set LastCell = .Cells(LastRow, LastCol)
        If LastCell Is Nothing Then Set LastCell = .Cells(1, 1)
    End With
    On Error GoTo 0
End Function
Sub ResetLastCellsOnAllWrkShtsAndSAVEFile(Optional wkb As Excel.Workbook = Nothing)
'Obj: to reset the last cell on all worksheets in the chosen workbook (it defaults to the activeworkbook if no wb is received)
'(by deleting excess formatting etc & then saving the file) to minimise file bloat etc
Const NumofEmptyBoundaryRowsAndCols As Long = 0 '### change as desired
Dim ws As Worksheet, LastRow As Long, LastCol As Long, LastCll As Range
Dim RowsInSS As Long, ColsInSS As Long, UserFB As VbMsgBoxResult
Dim NumOfUsedRngRows As Long    'Not used in calculations, only assigned a value while "resetting the usedrange property".

    Set wkb = IIf(wkb Is Nothing, ActiveWorkbook, wkb)
    UserFB = MsgBox("This macro will delete formatting or embedded objects " & _
                    "(eg charts, images, or even formatting such as borders) which sit outside the 'Used Range' on each of the " & _
                    "file's (" & wkb.FullName & ") worksheets, and then the macro saves the file.)" & vbCrLf & vbCrLf & _
                    "NOTE: saving a backup of your file is recommended before running this macro!" & _
                    vbCrLf & "Do you want to continue?", vbExclamation + vbYesNo, "MACRO WARNING!")
    Select Case UserFB
        Case Is = 6    'vbyes
            With wkb
                With .Sheets(1)    'arbitrary choice of the first sheet (to identify if there are 65k rows or 1,048k rows in the file)
                    RowsInSS = .Rows.Count
                    ColsInSS = .Columns.Count
                End With
                For Each ws In .Worksheets
                    ' Find the last real populated row & column
                    Set LastCll = LastCell(ws)
                    With LastCll
                        LastRow = .Row
                        LastCol = .Column
                    End With
                    With ws
                        'Delete excess rows or columns as needed (col's listed first b/c _
                         they are less likely to be in formulae)
                        '19/04/2010: can be changed from "1" to "2" because of borders on header sheets
                        If LastCol <> ColsInSS Then .Range(LastCll.Offset(0, 1 + NumofEmptyBoundaryRowsAndCols), .Cells(RowsInSS, ColsInSS)).EntireColumn.Delete
                        If LastRow <> RowsInSS Then .Range(LastCll.Offset(1 + NumofEmptyBoundaryRowsAndCols, 0), .Cells(RowsInSS, ColsInSS)).EntireRow.Delete
                        '5/10/2011, RB: to reset the "usedrange" property of the worksheet
        NumOfUsedRngRows = .UsedRange.Rows.Count
                    End With
                    Set LastCll = Nothing
                Next ws
                ''if desired...
                '.Save
            End With
        Case Else
            MsgBox "No changes made to the file. Please make any desired changes (eg save a backup of your file) & run the " & _
                   "macro again...", vbInformation + vbOKOnly, "FYI"
    End Select
    Set wkb = Nothing
End Sub

Open in new window


hth
Rob
0
 
LVL 10

Expert Comment

by:broro183
ID: 36914146
Ooopps,

Something went a bit wonky in my last post. Can you please slot these statements into the relevant section?

I haven't tried to make it robust (eg changed and tested against your stated limitations). I'm sure someone else can do it though... :-)
I think I'll wait until I'm in the mood for changing things before I give it another go.


Rob
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 36915015
>>>>Sid,
Could the use of "application.WorksheetFunction.CountA(...)" be faster than "For i = 1 To 7"?
Currently your code will refer to the activesheet, as the ranges don't appear to be explicitly qualified, & this may not always be the case.

@ Boro:

1) I am just looping 7 cells so it doesn't make any difference. Also I am trying to find the last row so I am not use why do you want to use "application.WorksheetFunction.CountA(...)" and complicate it? :)

2) All you need to do is add the sheet name before the range if the range is not in the active sheet ;)

Sid
0
 
LVL 10

Expert Comment

by:broro183
ID: 36919142
Ooopps again!

Hi Sid,
I think I should have left my last ideas on the screen overnight without hitting [Submit]!
1) Sorry, for some (nonsense) reason I had thought that you were looping through the 7 columns as a nested loop inside a row by row loop, but on re-reading your post, it's quite clear that you were never doing that.
2) Yep, we know to do that, but many others may not and it could be easy for errors to be made. In saying that, I guess I should have used an explicit worksheet name instead of just setting to the active sheet ;-)
Oh well, I guess we just need to wait for the OP now...

Sandramac,
Can you please clarify for us all:
- is it possible that there will be more populated cells after the first blank A:G section?
- do you have any formulae in cells that may return an empty string like ""?
- do you have other information in the columns to the right of G?
- if you do, is it likely to be in rows below the first blank section in columns A:G?
- do you want only the formats cleared in the A:G section (from the ?
- or do you want the formatting cleared for the "entirerows"?

Rob
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

What is a Form List Box? (skip if you know this) The forms List Box is the alternative to the ActiveX list box. If you are using excel 2007, you first make sure you have a developer tab (click the Orb)->"Excel Options"->Popular->"Show Developer tab…
INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now