Reduce the UsedRange

[Gringoire]

Hi,
I have a worksheet called DATA in Excel files (called Master) where I load data from others excel files.
Sometimes I need to load a huge amount of data (about 10.000.000 cells) but the most of times I just need about 100.000 cells.

The point is that once I loaded a big amount of data (280.000 rows) the UsedRange always preserve these monstruous dimensions and filesize increase from 1,5Mb to about 50Mb, making it very slow.

I already tried to reduce UserRange by VBA using some snippet like this one:

Sub Macro1()ActiveSheet.UsedRange
ActiveSheet.UsedRange.Clear
a = ActiveSheet.UsedRange.Rows.Count
ActiveWorkbook.Save
End Sub

but it doesn't work.

I also tried this (found by Google):

Public Sub delete_empty_row()    Application.ScreenUpdating = False


    For Each usedrng In ActiveSheet.UsedRange
        If usedrng.MergeCells = True Then
            If usedrng.Value = "" Then
                usedrng.Value = ""
            End If
        Else
            If usedrng.Value = "" Then
                usedrng.ClearContents
            End If
        End If
    Next
    
    ActiveSheet.UsedRange
    usedRangeLastColNum = ActiveSheet.UsedRange.Columns.Count
    usedrangelastrow = ActiveSheet.UsedRange.Rows.Count
    
    For r = usedrangelastrow To 1 Step -1
        If Application.WorksheetFunction.CountA(Cells(r, usedRangeLastColNum).EntireRow) <> 0 Then
            Exit For
        Else
            Cells(r, usedRangeLastColNum).EntireRow.Delete
        End If
    Next r
    
    For c = usedRangeLastColNum To 1 Step -1
        If Application.WorksheetFunction.CountA(Cells(1, c).EntireColumn) <> 0 Then
            Exit For
        Else
            Cells(1, c).EntireColumn.Delete
        End If
    Next c
    
    ActiveSheet.UsedRange
    Application.ScreenUpdating = True
End Sub

but I had to Ctrl+Break because after 20 minutes it was still working on a UsedRange of about 240.000 rows.

Does it exist a simple way to reduce the UsedRange?


thank you.

 

[JackDanIce]

I manually do the following:

Click on the cell you wish to have the last row and last column intersect on your sheet (e.g. your data is in range A1:J10, but pressing CTRL+END selects say M20 so I click on J10)
Delete all the rows below the selected cell, save the workbook (CTRL+S)
Delete all the columns to the right of the selected cell, savel the workbook.

After both saves, when I press CTRL+END, in this example it now selects J10 instead of M20.

This is not something I encounter a lot so for me it's faster to do this manually than code into a macro.

You may be able to use Ron De Bruin's link: finding last cell and adapt into your code

 

[Gringoire]

SOLVED: Reduce the UsedRange

Thank you! Your suggestion was very appreciated because I didn't know the manual procedure.
I easily transformed it in a short VBA snippet:

Rows("1:1").SelectRange(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp

size reduced from 50Mb to 1,05Mb

I wonder that all the other solution found in google don't work...

 

[JackDanIce]

Re: SOLVED: Reduce the UsedRange

You're welcome, glad it resolved.

It maybe the application of the solutions you found via an internet search weren't tailored to your requirement enough, I'm not sure wouldn't know I'm afraid!

 

[harleystack]

Re: SOLVED: Reduce the UsedRange

DELETING is better than CLEARING
This Is the only thing that worked for me consistently.

With VBA. After you think you have adjusted your Excel used range, test it in the immediate window.
(With my sheet i cleared everything after cell A2) ,i.e. "myrange.Clear"

Test range ....
?activesheet.usedrange.address
$A$1:$L$28


.....this was a problem .....
My solution is simple ... in short clearing cells is not the same as deleting cells.
Lets delete the cells then use "ActiveSheet.UsedRange" to reset it.

This is a use case with a arbitrary last row of 13000, that is more that i will ever see in my spreadsheet.


Sub clear_sheet()
Dim xlsheet As Excel.Worksheet

Set xlsheet = Worksheets("Orders")
With xlsheet
'Deleting cells A2 to L13000

.Range(Cells(2, 1), Cells(13000, 12)).Delete Shift:=xlUp
'just in case
ActiveSheet.UsedRange
End With


End Sub


After retesting in immediate window
?activesheet.usedrange.address
$A$1:$L$1