[RESOLVED] Fastest way to clear cells based on cel length

I have a huge amount of data (8000 rows x 100 columns). Most cells have a length of 3, many others are blank and some have lengths of 1 or 2. I need to clear cells if the cell length isn't 3. I know of course that I can do this

Code:

---

Dim cel As Range
For Each cel In MyRange
    If Len(cel) = 2 Or Len(cel) = 1 Then
        cel = ""
    End If
Next

---

but I'm looking for a faster way. Any ideas?

OUCH!
The only thing coming to mind would be to set a custom Autofilter "equals not ???" (question-marks are wildcards for single characters).
But i'm not sure if Autofilter "changes" the Range it's applied on or if it returns the changed range,
The idea would be to apply "ClearContents" to that range.

You would have to step columnwise through your sheet and apply above idea, so basically a loop 1 to 100.

kind of like (adjust columnwise or sheetwise)

Code:

---

    ActiveSheet.Range("$A$2:$A$8000").AutoFilter Field:=1, Criteria1:="<>???", Operator:=xlAnd
    ActiveSheet.AutoFilter.Range.ClearContents

---

Thanks. That's a little faster. I'm going to keep this question open for a while to see if there are other ideas.

Minuscule improvement

Code:

---

If Len(cel) < 3 Then

---

Quote:

---

Originally Posted by Zvoni

OUCH!
The only thing coming to mind would be to set a custom Autofilter "equals not ???" (question-marks are wildcards for single characters).
But i'm not sure if Autofilter "changes" the Range it's applied on or if it returns the changed range,
The idea would be to apply "ClearContents" to that range.

You would have to step columnwise through your sheet and apply above idea, so basically a loop 1 to 100.

kind of like (adjust columnwise or sheetwise)

Code:

---

    ActiveSheet.Range("$A$2:$A$8000").AutoFilter Field:=1, Criteria1:="<>???", Operator:=xlAnd
    ActiveSheet.AutoFilter.Range.ClearContents

---

---

Thanks.

I know this is already resolved, but another option is to convert the entirety of the range into a single string. Using the Names method (see below), this will return a string like:

Attachment 187992

={"Are","Kara","Bokutachi","Wa";"Nani","Ka","Wo","Shinjite";"Koreta","Ka","Na","!"}

Code:

---

Sub ConvertToString()

    Dim TargetName As Name
    Set TargetName = ThisWorkbook.Names.Add("JPOP", ThisWorkbook.Sheets("Sheet1").Range("A1:D3").Value)
    Debug.Print Names("JPOP")
   
    ' Output: ={"Are","Kara","Bokutachi";"Nani","Ka","Wo";"Koreta","Ka","Na"}
   
End Sub

---

Once it's in a string (and in memory), it should be a lot quicker than having to deal with the Range object. You could conceivably use the Regex replace method to find anything in the string (between quotation marks) of fewer than 3 characters in length and replace it with vbNullString.

Haven't tested the above regex step, but I assume it'll work.

Code:

---

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
   
    Dim vSheet As Variant
    vSheet = Sheets("Sheet1").Range("A1:BZ8000")
   
    Dim i As Long, j As Long
    Dim lLength As Long
    Dim lJUB As Long
    lJUB = UBound(vSheet, 2)
   
    For i = 1 To UBound(vSheet, 1)
        For j = 1 To lJUB
            lLength = Len(vSheet(i, j))
            If lLength = 1 Then
                vSheet(i, j) = vbNullString
            ElseIf lLength = 2 Then
                vSheet(i, j) = vbNullString
            End If
        Next j
    Next i
   
    Sheets("Sheet1").Range("A1:BZ8000") = vSheet
    With Application
        .DisplayStatusBar = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

---