PDA

View Full Version : Excel traversing Array Uses lots of Memory



fredlo2010
11-17-2014, 06:05 AM
Hello,

I am working on a code and I wonder how I could solve it. Basically excel is using a lot of my resources until it crashes.

I have a report that comes out of a program with some subtotals and I want to do some formatting on them: Make it bold, insert a row, push it to the side.

I dont want to loop through the whole range because it could be a lot of data; so I looped through the empty cells in the report and added the address to an array and then I am going backwards doing all my modifications. I started from the back to the from the back to the front because I will be adding some extra rows which messes up my for each range loops.

It works as proposed but there is a particular report that crashed; after a lot time trying to figure it out I noticed that excel was using a lot of my memory. There report is long indeed.

Total rows in the report: 274,540
Total Blank rows (aka ubound(subtotals)): 710

This is the code I am using. There are some other procedures here; ignore please I have tested them and everything is ok with them.


Private Sub CashDetail()

Dim lRow As Long
Dim i As Long
Dim r As Range
Dim arrSubTotal() As Variant


' Delete the first extra row
Rows(1).Delete


Call DeleteErrors
Call MoveTotalsCashDetail


' Loop trhough the empty values to create the range array
lRow = Cells(Rows.Count, 1).End(xlUp).Row


ReDim Preserve arrSubTotal(0)


For Each r In Cells(g_lngROW_DATA, 2).Resize(lRow - g_lngROW_HEADER).SpecialCells(xlCellTypeBlanks)
arrSubTotal(UBound(arrSubTotal)) = r.Address
ReDim Preserve arrSubTotal(UBound(arrSubTotal) + 1)
Next


' Remove the extra bound
ReDim Preserve arrSubTotal(UBound(arrSubTotal) - 1)


' Loop through the arras or ranges from the butom to
' the top and
For i = UBound(arrSubTotal) To LBound(arrSubTotal) Step -1

'''MEMORY BUMP STARTS GROWING WITH EACH ITERATION HERE'''
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' Make it bold and offset it.
If Not Range(arrSubTotal(i)).Offset(, -1).Value = vbNullString Then
Range(arrSubTotal(i)).Offset(, -1).Value = vbNullString
Range(arrSubTotal(i)).Resize(, 10).Font.Bold = True
Range(arrSubTotal(i)).Offset(, 3).HorizontalAlignment = xlRight
Range(arrSubTotal(i)).Resize(, 2).Insert Shift:=xlToRight

' If there is another total ontop of it then insert a row.
If Not i = LBound(arrSubTotal) Then
If Range(arrSubTotal(i - 1)).Row = Range(arrSubTotal(i)).Row - 1 Then
Range(arrSubTotal(i)).EntireRow.Insert Shift:=xlDown
End If
End If
End If
Next i




' Extra formattings.
Columns("A").Replace "'", ""

Columns("A").NumberFormat = "mm/dd/yyyy"
Columns("F:I").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
Columns("H:I").NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"


Columns("A:B").HorizontalAlignment = xlCenter
Columns("C:E").HorizontalAlignment = xlLeft


Call FormatHeadings(ActiveSheet, , g_lngROW_HEADER)


Range("A1").Resize(4).HorizontalAlignment = xlLeft


Columns("B:B").ColumnWidth = 14
Columns("E:E").ColumnWidth = 30
Columns("G:F").ColumnWidth = 30
Columns("A:A").ColumnWidth = 25.57
Columns("C:D").EntireColumn.AutoFit



Call FreezePanels("A6")


End Sub

Thanks a lot for the help.

fredlo2010
11-17-2014, 08:05 AM
Hello,

A quick update on this. I already got it to work. After reading a few forums and websites online this is what I did.

# Dimentioned my array as an array of strings and not a variant.
# Brought the Zoom from 75% to the default 100%
# Turned the calculations to manual.

With all of this fixes. My code ran without any breaks or memory problems. The memory usage went from about
1,500,000 K to a maximum of
315,000 K still kinda high but manageable.




Private Sub CashDetail()

Dim lRow As Long
Dim i As Long
Dim r As Range
Dim arrSubTotal() As String

' Restore the default zoom to reduce memory usage.
' turn off the calculations.
Call FixZoomTo(100)
Application.Calculation = xlCalculationManual



' Delete the first extra row
Rows(1).Delete

Call DeleteErrors
Call MoveTotalsCashDetail


' Loop trhough the empty values to create the range array
lRow = Cells(Rows.Count, 1).End(xlUp).Row


ReDim Preserve arrSubTotal(0)


For Each r In Cells(g_lngROW_DATA, 2).Resize(lRow - g_lngROW_HEADER).SpecialCells(xlCellTypeBlanks)
arrSubTotal(UBound(arrSubTotal)) = r.Address
ReDim Preserve arrSubTotal(UBound(arrSubTotal) + 1)
Next


' Remove the extra bound
ReDim Preserve arrSubTotal(UBound(arrSubTotal) - 1)


' Loop through the arras or ranges from the butom to
' the top and
For i = UBound(arrSubTotal) To LBound(arrSubTotal) Step -1


' Make it bold and offset it.
If Not Range(arrSubTotal(i)).Offset(, -1).Value = vbNullString Then
Range(arrSubTotal(i)).Offset(, -1).Value = vbNullString
Range(arrSubTotal(i)).Resize(, 10).Font.Bold = True
Range(arrSubTotal(i)).Offset(, 3).HorizontalAlignment = xlRight
Range(arrSubTotal(i)).Resize(, 2).Insert Shift:=xlToRight

' If there is another total ontop of it then insert a row.
If Not i = LBound(arrSubTotal) Then
If Range(arrSubTotal(i - 1)).Row = Range(arrSubTotal(i)).Row - 1 Then
Range(arrSubTotal(i)).Resize(1, 10).Insert Shift:=xlDown
End If
End If
End If

' Clear the spot
If Not UBound(arrSubTotal) = 0 Then
ReDim Preserve arrSubTotal(UBound(arrSubTotal) - 1)
End If
Next i

' Zoom Back to the desired zoom and turn on the calculations.
' We are dont with our expoensive memory transaction.
Call FixZoomTo(75)
Application.Calculation = xlCalculationAutomatic



' Extra formattings.
Columns("A").Replace "'", ""

Columns("A").NumberFormat = "mm/dd/yyyy"
Columns("F:I").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
Columns("H:I").NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"


Columns("A:B").HorizontalAlignment = xlCenter
Columns("C:E").HorizontalAlignment = xlLeft


Call FormatHeadings(ActiveSheet, , g_lngROW_HEADER)


Range("A1").Resize(4).HorizontalAlignment = xlLeft


Columns("B:B").ColumnWidth = 14
Columns("E:E").ColumnWidth = 30
Columns("G:F").ColumnWidth = 30
Columns("A:A").ColumnWidth = 25.57
Columns("C:D").EntireColumn.AutoFit



Call FreezePanels("A6")


End Sub

Any other suggestions or tips will be highly appreciated :)

Thanks

Aflatoon
11-19-2014, 08:41 AM
Using Redim Preserve is quite inefficient - it would be better to test the count of the visible cells, size the array, then loop and populate it.

fredlo2010
11-19-2014, 08:52 AM
Thanks for the tip Aflatoon.