Slow Macro with SpecialCells and looping

[georginat]

Hi all,

I am trying to run a macro to delete all the "..." in my excel document. I have tried to do this two ways, both by looping, and with special cells. Depending on the data, this is taking upwards of an hour. Does anyone have any reccommendations on how I can improve this. The data, does vary in length.

Looping:

Sub ellipses()
Sheets("RawData").Select
Range("A1").Select

Dim i As Integer
For i = 1 To 2658

Cells.Find(What:="...", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 1)).Select
Selection.Delete Shift:=xlToLeft

Next i

End Sub

Special Cells:
Sheets("RawData").Select
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=2, Criteria1:="..."
Columns("B:C").Select
Selection.ClearContents
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=2
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=3, Criteria1:="..."
Columns("C:D").Select
Selection.ClearContents
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=3
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=4, Criteria1:="..."
Columns("D:E").Select
Selection.ClearContents
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=4
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=5, Criteria1:="..."
Columns("E:F").Select
Selection.ClearContents
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=5
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=6, Criteria1:="..."
Columns("F:G").Select
Selection.ClearContents
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=6
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=7, Criteria1:="..."
Columns("G:H").Select
Selection.ClearContents
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=7
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=8, Criteria1:="..."
Columns("H:I").Select
Selection.ClearContents
ActiveSheet.Range("$A$1:$Y$21718").AutoFilter Field:=8

Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft

 

[AlphaFrog]

Try this...

Sub ellipsis()
    
    Dim rngFound As Range, rngAll As Range, FirstFound As String, i As Long
    
'    Sheets("RawData").Select
'    Range("A1").Select
    
    With Sheets("RawData").UsedRange
    
        Set rngFound = .Find(Chr(133))
    
        If Not rngFound Is Nothing Then
            FirstFound = rngFound.Address
            Do
                If rngAll Is Nothing Then
                    Set rngAll = rngFound
                Else: Set rngAll = Union(rngAll, rngFound)
                End If
                Set rngFound = .FindNext(After:=rngFound)
            Loop Until rngFound.Address = FirstFound
            
            Application.ScreenUpdating = False
            i = rngAll.Count
            rngAll.Delete Shift:=xlShiftToLeft
            Application.ScreenUpdating = True
            
        End If
    End With
    
    MsgBox i & " ellipsis deleted. ", , "Delete Ellipsis Complete"
    
End Sub

 

[georginat]

AlphaFrog

Thank you this is super quick! One question though- I'm trying to delete the "..." and the cell to the right of it. How do I do an offset with this code? Thank you!

 

[AlphaFrog]

You're welcome. Thanks fro the feedback.

                If rngAll Is Nothing Then
                    Set rngAll = [B]rngFound.Resize(, 2)[/B]
                Else: Set rngAll = Union(rngAll, [B]rngFound.Resize(, 2)[/B])
                End If

 

[Rick Rothstein]

Try this...

...    
   Set rngFound = .Find(Chr(133))
...

I think you need to specify some additional arguments for those that are retained from usage to usage (for example, the LookAt argument).