VBA code to remove random blank cells from a sheet

Question

What would be the VBA code to remove blank cells randomly placed in a spreadsheet. Input

ColA   ColB   ColC   ColD   ColE
 A             B             D
 H      J             I
 F             B             O

Output Should be like:

ColA   ColB   ColC   ColD   ColE
 A      B      D
 H      J      I
 F      B      O

Answer 1

This solution is very fast and is free from the three caveats listed in my comment below the OP question:

Public Sub CullValues()
    Dim i&, j&, k&, v
    v = ActiveSheet.UsedRange
    For i = 1 To UBound(v, 1)
        k = 0
        For j = 1 To UBound(v, 2)
            If Len(v(i, j)) Then
                k = k + 1
                v(i, k) = v(i, j)
                If j > k Then v(i, j) = Empty
            End If
        Next
    Next
    [a1].Resize(UBound(v, 1), UBound(v, 2)) = v
End Sub

Answer 2

You should really post at least an attempt of writing the code yourself.

That said, below is a working solution.

Option Explicit
Sub remove_blanks()
    Dim lrow As Long, lcol As Long, i As Long, j As Long, k As Long, r As Long
    Dim arrData() As Variant
    Dim wb As Workbook, ws As Worksheet, myrng As Range

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    ' Range can be made dynamic
    Set myrng = ws.Range("A1:BR103068")

    arrData = myrng.Value

    For i = LBound(arrData, 1) To UBound(arrData, 1)
        r = 0
        For j = LBound(arrData, 2) To UBound(arrData, 2)
            If arrData(i, j) = Empty Then
                For k = j To UBound(arrData, 2) - 1
                    arrData(i, k) = arrData(i, k + 1)
                Next k

                ' Last element emptied after first loop
                If k = UBound(arrData, 2) And r = 0 Then
                    arrData(i, k + r) = Empty
                End If
                r = r + 1 ' counts how many empty elements removed
            End If

            ' Exits loop after spaces removed from iteration
            If j + r = UBound(arrData, 2) Then
                Exit For
            End If

            ' Accounts for consecutive empty array elements
            If arrData(i, j) = Empty Then
                j = j - 1
            End If
        Next j
    Next i

    myrng.ClearContents
    myrng.Value = arrData
End Sub

I haven't tested @Excel Hero's, but it doesn't look like it shifts all elements up the array when it finds an empty element. The below will move all elements, and then iterate to the next empty element, until it reaches a point where all elements in that item have been assessed.

Testing on 70 columns and 100,000 rows of data, the code took 80 seconds to complete.