How do I remove zero-length strings in Excel using VBA?

Question

I've created a tool in VBA for Excel that analyses .xlsx files we receive based on a number of criteria. One of those is the number of empty cells in the dataset. Unfortunately, though, I have noticed that a number of the files we receive contain cells with zero-length-strings in them which are being "incorrectly" counted as non-empty cells.

It's actually highly beneficial to the whole process if I am just able to remove these from the file.

I have googled this problem a lot, but the only solution I have been able to find so far is to loop through all cells in the sheet (I've also tried just constants, and also using Find to find all zls). This isn't very efficient as the worksheets have large amounts of data in them. EDIT: I have also tried the UsedRange.values = UsedRange.values method, but this removes leading zeroes, which I require.

I have also discovered that this works (-@- is a random string that is highly unlikely to be a single cell in my data, and if it's there, is fine to be removed):

ws.UsedRange.Replace what:=vbNullString, replacement:="-@-", _
                            lookat:=xlWhole, MatchCase:=False
ws.UsedRange.Replace what:="-@-", replacement:="", _
                            lookat:=xlWhole, MatchCase:=False

but if I only do it using the single replace it doesn't:

ws.UsedRange.Replace what:=vbNullString, replacement:="", _
                            lookat:=xlWhole, MatchCase:=False

The first is ok, but has a number of problems:

1. It takes twice as long as a single replace
2. It's not always clear if it has crashed, or continued to work
3. If it does crash, I am left with a number of cells containing -@-, which isn't always obvious, and the tool should be ok to be used by someone who isn't able to understand VBA.

So my questions:

1. Is there a way of doing this using just a single replace? Why does replace work with the double replace, but not the single?
2. If the first isn't possible, then is there a way of 'rolling back' the replacement if the code crashes?
3. Is there a way of updating the status bar to show how far through the replace is to prove the code is running (much like when running replace in Excel itself)?
4. Or is there just a better way of doing it all?

Thanks in advance!

EDIT: Unfortunately, due to the data being processed, I need to retain formatting, including leading zeroes

EDIT: Here is an example of the sort of data I am looking at. I want to replace the zero-length-strings (which are non-blank cells that have no value in them) so they are a truly blank cell.

Answer 1

You can have cells with formulas that return a null string or cells with null string constants. To clear the second kind of cells:

Sub KillNullConstants()
    Dim cell As Range, Konstants As Range, rng As Range
    Set Konstants = ActiveSheet.UsedRange.Cells.SpecialCells(xlCellTypeConstants)
    Set rng = Nothing
    For Each cell In Konstants
        If Len(cell) = 0 Then
            If rng Is Nothing Then
                Set rng = cell
            Else
                Set rng = Union(rng, cell)
            End If
        End If
    Next cell

    If Not rng Is Nothing Then
        rng.ClearContents
    End If
End Sub

To clear formula cells that are returning null strings, just change the SpecialCells code line.

Answer 2

I know this is a loop as well but maybe a quicker way:

Before:

Run this code on sample data:

Dim X As Double

Option Explicit

Sub Test()

Application.ScreenUpdating = False
Application.Calculation = xlManual

With ActiveWorkbook.Sheets(1).Range("A1:C7")
    For X = 1 To 3
        .AutoFilter Field:=X, Criteria1:=""
        .Columns(X).Offset(1, 0).SpecialCells(xlCellTypeVisible).Clear
    Next X
    .AutoFilter
End With

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

End Sub

After:

Answer 3

Reading the sheet into an ADO Recordset then copying the Recordset on to a new sheet seems to fix this issue. Try this VBA code:

Sub copy_data()

Dim cn As Object
Set cn = CreateObject("ADODB.Connection")

With cn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
        "Extended Properties=""Excel 12.0 Macro;IMEX=1;HDR=YES"";"
    .Open
End With

Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")

rs.Open "SELECT * FROM [Sheet1$];", cn

Dim i As Integer
Dim fld As Object

With ThisWorkbook.Worksheets("Sheet2")
    .UsedRange.ClearContents

    i = 0
    For Each fld In rs.Fields
        i = i + 1
        .Cells(1, i).Value = fld.Name
    Next fld

    .Cells(2, 1).CopyFromRecordset rs
    .UsedRange.Columns.AutoFit
End With

rs.Close
cn.Close

End Sub

Notes:

• change the sheet names in the code to match the sheet names you are using. You have to put a $ sign after the sheet name you use in rs.Open. If your sheet was called "Data" then you would put rs.Open "SELECT * FROM [Data$];", cn
• in the connection string extended properties, HDR=YES was used to specify that the data has headers. ADO may change some of the column names if they contain certain characters - mainly the . character which will normally be replaced by the # character

Potential issues:

• your data needs to be roughly in a table format - i.e. column names in row 1 with data values below each column name
• any formulas in the data will be converted to values
• cell formatting will not be copied over - but numbers formatted as text will remain as text so leading zeroes will be preserved
• any cell value text longer than 255 characters is likely to be truncated to 255 characters (it is possible to work around this if needed)

Depending on your data, using ADO may create more issues than it solves