Solved: Can anyone confirm the destructive effect of Exceldiet in the following case?

[stranno]

I need confirmation regarding the genaral applicability of ExcelDiet. I have tested ExcelDiet on different worksheet ranges under different conditions and found out that it’s use can be harmful if applied on a rangew hose last row(s) is (are) filtered out by the autofilter. In this specific case ExcelDiet ‘eats’ the entire worksheet.
Can anyone confirm (reproduce) this? Can this problem be solved?

[GTO]

I would suggest attaching a 'before' wb with the code, so that we could test...

[stranno]

Any random spreadsheet is valid to demonstrate what i mean.

Here is an example. The determination of shapes are temporarily deactivated.

Click on "Select usedrange" to see de borders of the used range.
Then click on "Run ExcelDiet "and after that click on "Select usedrange" again to see what happened.

Then filter the name "Smith" in columnA out, so that row 15 is not visible anymore. Then click on "ExcelDiet" and you will see that the spreadsheet is gone.

[stranno]

May be i have a solution.

I think the example in my attachement is a far more reliable method to reset the usedrange. There is only one disadvantage. In case Excel's usedrange is much more extensive then de real usedrange, it 's less fast.

Please comment on my proposal.

Remove the quotes to really cut down the usedrange.

[Paul_Hossler]

I don't know which is faster, but this is what I do to shrink the worksheets.

Usually run it on all worksheets in a bloated workbook to get the data part as small as possible

Concept looks similar to the last workbook.

I will have to include the ExcelDiet code for shapes since that seems like it'd be useful

[VBA]
Option Explicit

Sub test()
Call ClearNotUsedRange
End Sub

Sub ClearNotUsedRange(Optional ws As Worksheet = Nothing)
Dim rLast As Range
Dim i As Long, iLastRow As Long, iLastCol As Long
Dim ws1 As Worksheet

If ws Is Nothing Then
Set ws1 = ActiveSheet
Else
Set ws1 = ws
End If

With ws1

Set rLast = .Cells.SpecialCells(xlLastCell)
iLastRow = rLast.Row
Do While Application.WorksheetFunction.CountA(.Rows(iLastRow)) = 0 And iLastRow <> 1
iLastRow = iLastRow - 1
Loop
iLastCol = rLast.Column
Do While Application.WorksheetFunction.CountA(.Columns(iLastCol)) = 0 And iLastCol <> 1
iLastCol = iLastCol - 1
Loop
Range(.Columns(iLastCol + 1), .Columns(.Columns.Count)).Delete
Range(.Rows(iLastRow + 1), .Rows(.Rows.Count)).Delete
End With
End Sub
[/VBA]

Paul

[GTO]

Hi All,

In response to the initial question, indeed, .Find does not appear to find data in cells hidden by filtering. How wacky! I was able to use xlFormulas and/or xlValues and find the last row of data if hidden by just plain old hiding, but any combo I could think to try would miss it if the range was hidden by filter.

Well, your and Paul's method certainly seems to rectify :-)

For kicks, I used DRJ's code and tacked in un-filtering if you will. Not well tested, but seems to work.

Option Explicit
    
Sub CallExcelDiet()
Call ExcelDiet
End Sub
    
Sub SelectUsedRange()
ActiveSheet.UsedRange.Select
End Sub
    
Sub ExcelDiet()
    
Dim j               As Long
Dim k               As Long
Dim LastRow         As Long
Dim LastCol         As Long
Dim ColFormula      As Range
Dim RowFormula      As Range
Dim ColValue        As Range
Dim RowValue        As Range
Dim Shp             As Shape
Dim ws              As Worksheet
    
Dim wksFilter           As AutoFilter
Dim aryFilters()        As Variant
Dim strFilterRngAddress As String
Dim i                   As Long
Dim bFilteringOn        As Boolean
Dim FiltCol             As Long
    
'    Application.ScreenUpdating = False
'    Application.DisplayAlerts = False
        
'    On Error Resume Next
    
    'For Each ws In Worksheets
    '//Added for test//
    Set ws = ActiveSheet
        With ws
            
            On Error Resume Next
            Set wksFilter = ws.AutoFilter
            On Error GoTo 0
            If Not wksFilter Is Nothing Then
                With wksFilter
                    strFilterRngAddress = .Range.Address
                    With .Filters
                        ReDim aryFilters(1 To .Count, 1 To 3)
                        For i = 1 To .Count
                            With .Item(i)
                                If .On Then
                                    bFilteringOn = True
                                    aryFilters(i, 1) = .Criteria1
                                    If .Operator Then
                                        aryFilters(i, 2) = .Operator
                                        aryFilters(i, 3) = .Criteria2
                                    End If
                                End If
                            End With
                        Next
                    End With
                End With
                If bFilteringOn Then ws.AutoFilterMode = False
            End If
        
            'Find the last used cell with a formula and value
            'Search by Columns and Rows
            On Error Resume Next
            Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
            Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
            Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            On Error GoTo 0
                    
            'Determine the last column
            If ColFormula Is Nothing Then
                LastCol = 0
            Else
                LastCol = ColFormula.Column
            End If
            If Not ColValue Is Nothing Then
                LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column)
            End If
                            
            'Determine the last row
            If RowFormula Is Nothing Then
                LastRow = 0
            Else
                LastRow = RowFormula.Row
            End If
            If Not RowValue Is Nothing Then
                LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row)
            End If
                
            'Determine if any shapes are beyond the last row and last column
            For Each Shp In .Shapes
                j = 0
                k = 0
                On Error Resume Next
                j = Shp.TopLeftCell.Row
                k = Shp.TopLeftCell.Column
                On Error GoTo 0
                If j > 0 And k > 0 Then
                    Do Until .Cells(j, k).Top > Shp.Top + Shp.Height
                        j = j + 1
                    Loop
                    If j > LastRow Then
                        LastRow = j
                    End If
                    Do Until .Cells(j, k).Left > Shp.Left + Shp.Width
                        k = k + 1
                    Loop
                    If k > LastCol Then
                        LastCol = k
                    End If
                End If
            Next
                    
            .Range(Cells(1, LastCol + 1).Address & ":IV65536").Delete
            .Range(Cells(LastRow + 1, 1).Address & ":IV65536").Delete
        
            If bFilteringOn Then
                .AutoFilterMode = False
                For FiltCol = 1 To UBound(aryFilters, 1)
                    If Not IsEmpty(aryFilters(FiltCol, 1)) Then
                        If aryFilters(FiltCol, 2) Then
                            .Range(strFilterRngAddress).AutoFilter Field:=FiltCol, _
                                                                   Criteria1:=aryFilters(FiltCol, 1), _
                                                                   Operator:=aryFilters(FiltCol, 2), _
                                                                   Criteria2:=aryFilters(FiltCol, 3)
                        Else
                            .Range(strFilterRngAddress).AutoFilter Field:=FiltCol, _
                                                                   Criteria1:=aryFilters(FiltCol, 1)
                        End If
                    End If
                Next
            End If
        End With
    'Next
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

DRJ's original work may be seen at:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=83

Mark

[Paul_Hossler]

Mark -- much better than all my looping, or at least more elegant.

I'll have to play with it (just for safety's sake ) but I'm going to update my toolbox to use it

Paul

[GTO]

Hi Paul,

Certainly a nice catch by Stranno. I have used DRJ's code several times w/o fail, but I don't do much (if any) filtering.

As to .Find. Sheesh! I knew the difficulties in Dates, but autofilter too? Hopefully next ver gets options:

.Find.SeeingEyeDog = True

A nice day to all, off to the rack for this one,

Mark

[stranno]

Hi Paul and Mark,

Add the next code line and the effect (cut down of the false used range) will take place immediately. But I think you both knew this workaround.

iLastRow = .UsedRange.Rows.Count

Anyway, thanks for your comments

[Paul_Hossler]

If you shade an empty cell and then clear it, the .Rows.Count still doesn't reset the LastUsed either

Best (my opinion of course) way is to CountA and delete, or use Mark's un-fillter/re-filter approach


Paul