Optimization question

[Lavina]

Hey guys,

im working on a big amount of data, and my initial step is to clear all the useless rows, what i describe as useless: if cell (M+rowNr) does not start with 25 26 or 27

So my code looks like this:

Sub DataCleanUp()
Dim counter1 As Integer, lastrow As Integer
lastrow = Cells.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For counter1 = lastrow To 1 Step -1
If left(Range("M" + CStr(counter1)).Value,2) <> "25" And left(Range("M" + CStr(counter1)).Value,2) <> "26" And left(Range("M" + CStr(counter1)).Value,2) <> "27" Then
Rows(counter1).Delete
End If
Next
End Sub

And its really slow, how can i do this faster?

I can setup a custom sort and after sorting everything make a cutoff right after 27 ends, but maybe there's just a better way to search in vba that i need to learn

 

[James006]

Hello,

The most efficient way is to use Filter ... and delete visible rows ...

Hope this will help

 

[MickG]

Try adding "Screenupdating" as below.

Sub DataCleanUp()
Dim counter1 As Integer, lastrow As Integer, t
 t = Timer
lastrow = Cells.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Application.ScreenUpdating = False
For counter1 = lastrow To 1 Step -1
If Left(Range("M" + CStr(counter1)).Value, 2) <> "25" And Left(Range("M" + CStr(counter1)).Value, 2) <> "26" And Left(Range("M" + CStr(counter1)).Value, 2) <> "27" Then
Rows(counter1).Delete
End If
Next
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

 

[Lavina]

Try adding "Screenupdating" as below.

Sub DataCleanUp()
Dim counter1 As Integer, lastrow As Integer, t
 t = Timer
lastrow = Cells.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Application.ScreenUpdating = False
For counter1 = lastrow To 1 Step -1
If Left(Range("M" + CStr(counter1)).Value, 2) <> "25" And Left(Range("M" + CStr(counter1)).Value, 2) <> "26" And Left(Range("M" + CStr(counter1)).Value, 2) <> "27" Then
Rows(counter1).Delete
End If
Next
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

I forgot to mention i run:
Sub OptimizeCode_Begin()
Dim EventState As Variant
Dim CalcState As Variant
Dim PageBreakState As Variant

Application.ScreenUpdating = False

EventState = Application.EnableEvents
Application.EnableEvents = False

CalcState = Application.Calculation
Application.Calculation = xlCalculationManual

PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

End Sub
And OptimizeCode_End as the last sub

 

[Lavina]

Hello,

that seems like an interesting idea, but as far as i see right now, in vba i can input what i want to filter on ( so i could see only rows that start with 25, 26, 27), thus i could make everything i find interesting visible, but not vice versa. Is there any way to filter by stating: filter display all except these?

 

[James006]

Hello,

If you feel like digging any further about how to use advanced filter ...

https://www.thespreadsheetguru.com/...automate-filtering-on-and-out-specific-values

Hope this will help

 

[Fluff]

It's best to delete all the rows at the same rather than one by one

Sub DataCleanUp()
   Dim Counter1 As Integer, lastrow As Integer
   Dim Rng As Range
   
   lastrow = Cells.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
   For Counter1 = lastrow To 1 Step -1
      If Left(Range("M" + CStr(Counter1)).Value, 2) <> "25" And Left(Range("M" + CStr(Counter1)).Value, 2) <> "26" And Left(Range("M" + CStr(Counter1)).Value, 2) <> "27" Then
        If Rng Is Nothing Then Set Rng = Cells(Counter1, 1) Else Set Rng = Union(Rng, Cells(Counter1, 1))
      End If
   Next
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

 

[footoo]

Here's another possibility :

Sub DataCleanUp()
Dim lastrow As Integer, dic As Object, ray As Variant, x%
lastrow = Cells.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Set dic = CreateObject("Scripting.Dictionary")
With ActiveSheet
    If .AutoFilterMode Then .AutoFilterMode = False
    Rows(1).Insert
    With .Range("M1:M" & lastrow)
        ray = .Cells.Value2
        For x = LBound(ray, 1) + 1 To UBound(ray, 1)
            If Not CStr(ray(x, 1)) Like "25*" And Not CStr(ray(x, 1)) Like "26*" And Not CStr(ray(x, 1)) Like "27*" Then _
                If Not dic.Exists(CStr(ray(x, 1))) Then _
                dic.Add Key:=CStr(ray(x, 1)), Item:=ray(x, 1)
        Next
        If CBool(dic.Count) Then
            .AutoFilter Field:=1, Criteria1:=dic.Keys, _
                Operator:=xlFilterValues, VisibleDropDown:=False
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End If
    End With
    Rows(1).Delete
End With
End Sub

 

[James006]

For reference purposes .. an excellent explanation about Deleting Rows

https://www.ozgrid.com/VBA/VBACode.htm

Hope this will help

 

[kashif.special2005]

Hi Lavina,

please find below code to delete rows very very fast.

Note:- Please adjust the column number in the bold value.

Sub DeleteRows()
    
    Dim rng As Range
    Dim mydata As Variant, mynew() As Variant
    Dim row_insert As Long, delcount As Long, i As Long, j As Long, lLastRow As Long
    Dim iLastCol As Integer
    Dim dtime As Date
    Dim strValue As String


    'Freeze screen
    Application.ScreenUpdating = False
    
    dtime = Now()
   
    With Sheet8
        'Determine last row
        lLastRow = .Cells.Find(what:="*", _
                                after:=[a1], _
                                searchorder:=xlByRows, _
                                searchdirection:=xlPrevious).Row
        
        iLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        'Setting data range
        Set rng = .Range("A1", .Cells(lLastRow, iLastCol))
    End With


    mydata = rng.Value
    
    For i = 2 To UBound(mydata, 1)
        'Change the target column here to find value in the column 13 is "M"
        strValue = Left(mydata(i, 13), 2)
        If strValue <> "25" And strValue <> "26" And strValue <> "27" Then
            mydata(i, 13) = "For Delete Row"
            delcount = delcount + 1
        End If
    Next i
    
    delcount = UBound(mydata, 1) - delcount
    
    ReDim mynew(1 To delcount, 1 To iLastCol)
    
    row_insert = 1
    
    For i = LBound(mydata, 1) To UBound(mydata, 1)
        'Checking the value in the target column 13 that is "M"
        If mydata(i, 13) <> "For Delete Row" Then
            For j = LBound(mydata, 2) To UBound(mydata, 2)
                mynew(row_insert, j) = mydata(i, j)
            Next j
            row_insert = row_insert + 1
        End If
    Next i
    
    Sheets.Add
    
    Range("A1").Resize(UBound(mynew, 1), UBound(mynew, 2)).Value = mynew


    MsgBox Format(Now() - dtime, "hh:mm:ss")
    
End Sub

Thanks
Kashif