Speed up VBA marco

Question

I have a macro that does work, it's just really slow when there is a lot of data and I'm hoping that someone on here can help me to speed it up.

When my VBA does is check the columns of a sheet for the value "NULL" and if it's there it clears that cell. Here's the code:

Sub RemoveNullColumn()
    Dim c, count, r, lc, FirstCell
    Application.ScreenUpdating = False
    count = 0
    r = ActiveCell.row      'lets you choose where you want to start even if it is not at "A1"
    c = ActiveCell.Column   'lets you choose where you want to start even if it is not at "A1"
    c = GetLetterFromNumber(c)  'Gets the column letter from the number provided above
    FirstCell = c & r       'sets the cell that you selected to start in so that you will end thereafter removing all the NULL

    lc = ActiveSheet.Cells(1, Columns.count).End(xlToLeft).Column   'Finding the last used column
    For H = ActiveCell.Column To lc Step 1      'Starts with where you selected a cell and moves right to the last column
        For x = 1 To Range(c & Rows.count).End(xlUp).row Step 1     'Starts with the first row and moves through the last row
            count = count + 1
            If Range(c & x).Value = "NULL" Then 'Checks the contents fo the cell to see if it is "NULL"
                Range(c & x).Clear
            End If
            If count = 1000 Then    'This was used testing but is not seen with the ScreenUpdating set to false
                Range(c & x).Select
                count = 1
            End If
        Next x
        ActiveCell.Offset(0, 1).Select  'select the next column
        c = ActiveCell.Column
        c = GetLetterFromNumber(c)      'get the letter of the next column
    Next H
    Application.ScreenUpdating = True
    MsgBox "Finished"
    Range(FirstCell).Select
End Sub

Function GetLetterFromNumber(Number)
    GetLetterFromNumber = Split(Cells(1, Number).Address(True, False), "$")(0)
End Function

When there are not a lot of rows it is pretty fast, but there are a lot of rows it is slow.

I have a file that I ran it on that has columns from A to AD and 61k+ rows, it took more than 30 minutes to finish and I'm hoping to make that much faster.

Answer 1

Instead of looking into Every single cell in the worksheet, use Replace function which is far faster :(you may need to edit it customize it to your needs)

Example :

Sub RemoveNullColumn()

  Dim targetSheet As Worksheet
  Set targetSheet = ActiveSheet 'TODO: replace with a stronger object reference

  targetSheet.Cells.Replace What:="NULL", Replacement:="", LookAt:=xlWhole, _
  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
   ReplaceFormat:=False
End Sub

This will make sure you will preserve the format.

Answer 2

If you want to clear NULL using ActiveCell as reference:

Range(ActiveCell, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="NULL", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
    ReplaceFormat:=False

Answer 3

Please give this a try...

Sub RemoveNullColumn()
Dim lr As Long, lc As Long
Dim rng As Range, cell As Range, FirstCell As Range

With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lc = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Set FirstCell = ActiveCell
Set rng = Range(Cells(1, FirstCell.Column), Cells(lr, lc))

For Each cell In rng
    If cell.Value = "NULL" Then
        cell.Clear
    End If
Next cell

With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With
MsgBox "Finished"
End Sub

Answer 4

Use a .Find/.FindNext to collect all of the matching cells into a Union then clear the contents of the Union'ed cells.

Option Explicit

Sub noNULLs()
    Dim firstAddress As String, c As Range, rALL As Range
    With ActiveSheet.Cells    'This should be named worksheet like Worksheets("sheet1")
        Set c = .Find("NULL", MatchCase:=True, _
                      LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Set rALL = c
            firstAddress = c.Address
            Do
                Set rALL = Union(rALL, c)
                Set c = .FindNext(c)
            Loop While c.Address <> firstAddress
            rALL.Clear
        End If
    End With
End Sub