Very Large Data Sets - Deleting Rows

Hey Group,

It has been a while. Hope this is an easy question.

I am now working with very large datasets of almost 50,000 rows and 40+ columns of data per worksheet with a dozen worksheets in the workbook. The data is weather information taken at every minute of the day. Each worksheet is a month of data. I am trying analyze the data but that is taking a tremendous amount of time. Therefore, I am trying to reduce the minute information to an average hourly information.

With some help, I am using the code below (which is much better than the code I had been using for a long time).

In column A I have created an identifier to provide an * if the data is not required and blank if it is. Then I run the code to find those rows and delete them. However, with almost 50000 rows of data, it is very time consuming. The end result is around 800 rows.

First, is there a better way to work with so much data without deleting portions of the whole data?
Second, the code below works but takes a long amount of time. Is there a more efficient way?

Const xlUp As Long = -4162

Sub DeleteMarkedRows2016()
    Dim lastrow
    Dim Rng As Range
    Dim ws As Worksheet

Set ws = ActiveSheet
Application.ScreenUpdating = False

'Determine last row of data in worksheet
With ws

    If WorksheetFunction.CountA(.Cells) <> 0 Then
        lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastrow = 1
    End If

    Set Rng = ws.Range("A1:A" & lastrow)
    Debug.Print Rng.Address
End With

Dim MySel As Range

'Create a collection of rows to be deleted and delete
For Each cell In Rng
    If cell.Value = "*" Then
        If MySel Is Nothing Then
            Set MySel = Rows(cell.Row)
        Else
            Set MySel = Union(MySel, Rows(cell.Row))
        End If
    End If
    
Next cell

If Not MySel Is Nothing Then
    With MySel
        .Delete

    End With
End If

Application.ScreenUpdating = True

End Sub

Add the below code to a module:

Sub OptimizeCode_Begin()

Application.ScreenUpdating = False

EventState = Application.EnableEvents
Application.EnableEvents = False

CalcState = Application.Calculation
Application.Calculation = xlCalculationManual

PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

End Sub

Sub OptimizeCode_End()

ActiveSheet.DisplayPageBreaks = PageBreakState
Application.Calculation = CalcState
Application.EnableEvents = EventState
Application.ScreenUpdating = True

End Sub

...then call OptimizeCode_Begin in the beginning of your code, and at the end of your code call OptimizeCode_End

Hope this does something

This was helpful. Thank you

I agree with Trevor, it can be done without using VBA.
But if you need vba, this one might do the job.
Try this:
The output is in sheet2

Sub b1132774()
Dim rc As Long, rr As Long, i As Long
Dim r As Range
Dim ws2 As Worksheet

rr = Range("B" & Rows.count).End(xlUp).row
rc = Cells(1, Columns.count).End(xlToLeft).Column
Set ws2 = sheets("sheet2") 'change this sheet name to suit
i = 2
For Each r In Range("A2:A" & rr).SpecialCells(xlCellTypeBlanks)
ws2.Range(ws2.Cells(i, "A"), ws2.Cells(i, rc)).Value = r.Resize(1, rc).Value
i = i + 1
Next

End Sub