I think my macro quits before I do...

[shipleyscott]

I wrote a macro that I use to analyze the outputs of a 2-d hydraulic flow model. It gets rid of the junk data and moves the data I want to analyze near the "origin" of the webpage. It worked on a pretty large data set when we had a 3' sized grid, but the excel crashes when I run it on the output of a 1' sized matrix. It is about 4500 x 4500 cells in size before I run the macro. The macro looks like:


Sub removeinplace()
‘This sub replaces all of the junk data (-9999) with blank cells but does not affect cells that do not have (-‘9999) in them.
‘This sub calls DeleteBlankColumns and DeleteBlankRows to move the cluster (it is a contiguous
‘cluster) ‘of data closer to the origin where I can work with it.

' define Myrange
Set MyRange = ActiveSheet.UsedRange

With ActiveSheet.UsedRange
.Replace -9999, "", xlWhole, SearchFormat:=False, ReplaceFormat:=False
End With

Call DeleteBlankColumns

Call DeleteBlankRows

End Sub
Sub DeleteBlankColumns()
‘This sub deletes blank columns
'Step1: Declare your variables.
Dim iCounter As Long
Dim MaxColumns As Long

'Step 2: Define the target Range.
With ActiveSheet

MaxColumns = ActiveSheet.Range("B1").Value

'Step 3: Start reverse looping through the range.
For iCounter = MaxColumns To 1 Step -1

'Step 4: If entire column is empty then delete it.
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
'Step 5: Increment the counter down
Next iCounter
End With
End Sub

------------------------------------------------------------------------------------------------------------------------------------------
Sub DeleteBlankRows()
‘This sub deletes blank rows.
'Step1: Declare your variables.
Dim iCounter As Long
Dim MaxRows As Long

'Step 2: Define the target Range.
With ActiveSheet
MaxRows = ActiveSheet.Range("B2").Value

'Step 3: Start reverse looping through the range.
For iCounter = MaxRows To 1 Step -1

'Step 4: If entire row is empty then delete it.
If Application.CountA(Rows(iCounter).EntireRow) = 0 Then
Rows(iCounter).Delete
End If
'Step 5: Increment the counter down
Next iCounter
End With
End Sub


What am I doing wrong?

(I wasn't able to load sample data because it was too large of a file).

 

[tonyyy]

shipleyscott,

Don't know why the macros would work on one data set and not another, and it isn't' clear what happens when "excel crashes." That said, the following contains a bit of clean up and consolidation...

Sub removeinplace()
'This sub replaces all of the junk data (-9999) with blank cells but does not affect cells that do not have (-‘9999) in them.
'This sub then DeleteBlankColumns and DeleteBlankRows to move the cluster (it is a contiguous
'cluster) ‘of data closer to the origin where I can work with it.
Application.ScreenUpdating = False
Dim iCounter As Long, MaxColumns As Long, MaxRows As Long
ActiveSheet.UsedRange.Replace what:=-9999, replacement:="", lookat:=xlWhole, SearchFormat:=False, ReplaceFormat:=False

'Delete blank columns
With ActiveSheet
    MaxColumns = .Range("B1").Value
    For iCounter = MaxColumns To 1 Step -1
        If Application.CountA(Columns(iCounter)) = 0 Then .Columns(iCounter).Delete
    Next iCounter

'Delete blank rows
    MaxRows = .Range("B2").Value
    For iCounter = MaxRows To 1 Step -1
        If Application.CountA(Rows(iCounter)) = 0 Then .Rows(iCounter).Delete
    Next iCounter
End With
Application.ScreenUpdating = True
End Sub

You'll first note the three macros are now condensed into one; sometimes calling routines can upset the timing of events and cause strange things to happen. The .Replace method arguments are now all qualified; sometimes mixing unqualified and qualified arguments can cause excel to become confused. If the "-9999" is formatted as text, then the number should be surrounded by quotation marks; otherwise leave as is.

And since there was no sample data the code is untested.

Cheers,

tonyyy

 

[shipleyscott]

Thanks Tonyyy--

I still couldn't get it to work. I'd upload some sample data but it is a big size. What is a good way to upload large files? I've now tried to run it on several machines and actually downloaded Office 2016, but none of this has worked. One did go from being frozen to giving the error message that the memory was full...

shipleyscott,

Don't know why the macros would work on one data set and not another, and it isn't' clear what happens when "excel crashes." That said, the following contains a bit of clean up and consolidation...

Sub removeinplace()
'This sub replaces all of the junk data (-9999) with blank cells but does not affect cells that do not have (-‘9999) in them.
'This sub then DeleteBlankColumns and DeleteBlankRows to move the cluster (it is a contiguous
'cluster) ‘of data closer to the origin where I can work with it.
Application.ScreenUpdating = False
Dim iCounter As Long, MaxColumns As Long, MaxRows As Long
ActiveSheet.UsedRange.Replace what:=-9999, replacement:="", lookat:=xlWhole, SearchFormat:=False, ReplaceFormat:=False

'Delete blank columns
With ActiveSheet
    MaxColumns = .Range("B1").Value
    For iCounter = MaxColumns To 1 Step -1
        If Application.CountA(Columns(iCounter)) = 0 Then .Columns(iCounter).Delete
    Next iCounter

'Delete blank rows
    MaxRows = .Range("B2").Value
    For iCounter = MaxRows To 1 Step -1
        If Application.CountA(Rows(iCounter)) = 0 Then .Rows(iCounter).Delete
    Next iCounter
End With
Application.ScreenUpdating = True
End Sub

You'll first note the three macros are now condensed into one; sometimes calling routines can upset the timing of events and cause strange things to happen. The .Replace method arguments are now all qualified; sometimes mixing unqualified and qualified arguments can cause excel to become confused. If the "-9999" is formatted as text, then the number should be surrounded by quotation marks; otherwise leave as is.

And since there was no sample data the code is untested.

Cheers,

tonyyy

 

[tonyyy]

What is a good way to upload large files?

Typically people will upload their files to DropBox, google drive or some other cloud service, then post a link here.

 

[shipleyscott]

Let's try this:
https://www.dropbox.com/s/5zzii6f2ma84d50/ecvelocity100.prj?dl=0<strike></strike>

 

[Fluff]

That link is for a prj file not an xl file

 

[shipleyscott]

sorry, my bad:

https://www.dropbox.com/s/f9j9o2wt9tpak8x/ecvelocity100.txt?dl=0

it is a txt that is space delineated.

 

[tonyyy]

It worked on a pretty large data set when we had a 3' sized grid, but the excel crashes when I run it on the output of a 1' sized matrix. It is about 4500 x 4500 cells in size before I run the macro.

Was the data set for the 3' grid larger than the data set for the 1' sized matrix? That was the implication from the above quote, but I have to believe not.

The code from post #2 ran for a bit over 2 hours before I stopped it. I then tried reading the UsedRange into an array and received an Out of Memory error. (I'm running a 64-bit operating system with 8GB of memory and 32-bit Excel.)

The following works on my machine for the first 1000 rows and takes about 20 seconds...

Sub DeleteBlankRowsColumnsInArray_1021652r2()
Application.ScreenUpdating = False
    Dim myTimer As Double
    myTimer = Timer

Dim arr1 As Variant, arr2 As Variant, arr3 As Variant
Dim LastRow As Long, LastColumn As Long
Dim i As Long, j As Long, rw As Long, col As Long
Dim ws As Worksheet
Dim wb As Workbook
Set ws = ThisWorkbook.Sheets("ecvelocity100")

'LastRow = ws.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, _
'    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
LastColumn = ws.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
LastRow = 1000 'Arbitrary limit to avoid out of memory error
    
arr1 = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, LastColumn))
ReDim arr2(1 To LastRow, 1 To LastColumn)
ReDim arr3(1 To LastRow, 1 To LastColumn)

''''Delete -9999
For i = 1 To UBound(arr1, 1)
    For j = 1 To UBound(arr1, 2)
        arr1(i, j) = Replace(arr1(i, j), -9999, "")
    Next j
Next i

''''Delete blank rows
rw = 1
For i = LBound(arr1) To UBound(arr1)
    For j = 1 To LastColumn
        If arr1(i, j) <> "" Then
            For col = 1 To LastColumn
                arr2(rw, col) = arr1(i, col)
            Next col
            rw = rw + 1
            Exit For
        End If
    Next j
Next i

''''Delete blank columns
col = 1
For i = 1 To LastColumn
    For j = 1 To LastRow
        If arr2(j, i) <> "" Then
            For rw = 1 To LastRow
                arr3(rw, col) = arr2(rw, i)
            Next rw
            col = col + 1
            Exit For
        End If
    Next j
Next i

''''Paste result to new workbook
Set wb = Workbooks.Add
wb.Sheets(1).Range(Sheets(1).Cells(1, 1), Sheets(1).Cells(LastRow, LastColumn)).Value = arr3
wb.Sheets(1).Columns.AutoFit

Application.ScreenUpdating = True
MsgBox "The dishes are done dude!"
    myTimer = (Timer - myTimer) / 86400
    MsgBox prompt:=Format(myTimer, "hh:mm:ss"), Title:="Elapsed Time"
End Sub

You'd have to break up your data set into 1000 row increments, then later merge the results.

If you can access a 64-bit machine with 64-bit excel with lots of memory, you might try commenting out the "LastRow = 1000" line and uncommenting the previous "LastRow..."

 

[tonyyy]

Latest (last?) revision...

Sub DeleteBlankRowsColumnsInArray_1021652r3()
Application.ScreenUpdating = False
    Dim myTimer As Double
    myTimer = Timer

Dim arr1 As Variant, arr2 As Variant, arr3 As Variant
Dim LastRow As Long, LastColumn As Long, FirstRow As Long, RealLastRow
Dim i As Long, j As Long, rw As Long, col As Long, lr As Long, lc As Long
Dim ws As Worksheet
Dim wb As Workbook
Set ws = ThisWorkbook.Sheets("ecvelocity100")
Set wb = Workbooks.Add

Do
RealLastRow = ws.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
LastColumn = ws.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
LastRow = LastRow + 1000 'Arbitrary limit to avoid out of memory error

If LastRow > 1000 Then
    FirstRow = FirstRow + 1000
Else
    FirstRow = 1
End If

arr1 = ws.Range(ws.Cells(FirstRow, 1), ws.Cells(LastRow, LastColumn))
ReDim arr2(1 To 1000, 1 To LastColumn)
ReDim arr3(1 To 1000, 1 To LastColumn)

''''Delete -9999
For i = 1 To UBound(arr1, 1)
    For j = 1 To UBound(arr1, 2)
        arr1(i, j) = Replace(arr1(i, j), -9999, "")
    Next j
Next i

''''Delete blank rows
rw = 1
For i = LBound(arr1) To UBound(arr1)
    For j = 1 To LastColumn
        If arr1(i, j) <> "" Then
            For col = 1 To LastColumn
                arr2(rw, col) = arr1(i, col)
            Next col
            rw = rw + 1
            Exit For
        End If
    Next j
Next i

''''Delete blank columns
col = 1
For i = 1 To LastColumn
    For j = 1 To 1000
        If arr2(j, i) <> "" Then
            For rw = 1 To 1000
                arr3(rw, col) = arr2(rw, i)
            Next rw
            col = col + 1
            Exit For
        End If
    Next j
Next i

'''''Determine last row/column of arr3
For i = LBound(arr3) To UBound(arr3)
    For j = LBound(arr3) To UBound(arr3)
        If arr3(i, j) <> "" Then
            If i > lr Then lr = i
            If j > lc Then lc = j
        End If
    Next j
Next i

''''Paste result to new workbook
wb.Sheets(1).Range(Sheets(1).Cells(FirstRow, 1), Sheets(1).Cells(LastRow + lr, lc)).Value = arr3
wb.Sheets(1).Columns.AutoFit

Loop Until RealLastRow < LastRow

Application.ScreenUpdating = True
MsgBox "The dishes are done dude!"
    myTimer = (Timer - myTimer) / 86400
    MsgBox prompt:=Format(myTimer, "hh:mm:ss"), Title:="Elapsed Time"
End Sub

So this latest revision loops through the original data set a thousand rows at a time, replacing -9999s with blanks and deleting blank rows and columns, and pasting the results into a new workbook. Takes about a minute and a half.

Can't believe I got it to work!