Dealing with million plus blank rows

[cluelessdood]

Hello, everyone! I'm having some trouble with a macro that I inherited from my predecessor. Basically, the issue is that, after the macro has successfully completed, it ends up adding the max amount of blank rows possible in Excel (over a million). I'm still a VBA noob, so I kinda feel overwhelmed with the code. Currently, I just have a separate macro that's deleting the rows after the main macro has finished running. It works, but it isn't pretty, since you have to use two macros, just to get the end result that you want. The best solution would just to know how to code the main macro, so it doesn't end up inserting the blank rows. The second best option would be merging the "DeleteBlankRows" macro with the main macro.

Sub DeleteUnused()
  

Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range


For Each wks In ActiveWorkbook.Worksheets
  With wks
    myLastRow = 0
    myLastCol = 0
    Set dummyRng = .UsedRange
    On Error Resume Next
    myLastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row
    myLastCol = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByColumns).Column
    On Error GoTo 0

    If myLastRow * myLastCol = 0 Then
        .Columns.Delete
    Else
        .Range(.Cells(myLastRow + 1, 1), _
          .Cells(.Rows.Count, 1)).EntireRow.Delete
        .Range(.Cells(1, myLastCol + 1), _
          .Cells(1, .Columns.Count)).EntireColumn.Delete
    End If
  End With
Next wks

End Sub

'================================
Sub TestForMergedCells()

  Dim AnyMerged As Variant

  AnyMerged = ActiveSheet.UsedRange.MergeCells

  If AnyMerged = False Then
      MsgBox "no merged"
  ElseIf AnyMerged = True Then
      MsgBox "all merged"
  ElseIf IsNull(AnyMerged) Then
      MsgBox "mixture"
  Else
      MsgBox "never gets here--only 3 options"
  End If

End Sub
'=====================================

[FoxSeaLady]

Hi

Would you like to upload the main macro which may be easily modified.

Cheers

[AB33]

Could you attach a sample with millions of blank rows?