Missing Values in Excel

Option Explicit
Sub FindBlanks()
    Dim LastRow As Long
    Dim LastCol As Integer
    Dim rFound As Range
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim FindRange As Range
    Dim MyAddress As String
    Dim r As Range
    Dim i As Long
    
    Set ws = ActiveSheet
    Application.ScreenUpdating = False
 
    LastRow = ws.UsedRange.Rows.Count
    LastCol = ws.UsedRange.Columns.Count
    
    With ws.Range(Cells(1, 1), Cells(LastRow, LastCol))
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
            Formula1:="="""""
        .FormatConditions(1).Interior.ColorIndex = 6
        Set rFound = .Find(What:="", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
                xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                , SearchFormat:=False)
        
        If Not rFound Is Nothing Then
            Set FindRange = rFound
            MyAddress = rFound.Address
            Do
                Set FindRange = Union(FindRange, rFound)
                Set rFound = .FindNext(rFound)
            Loop While Not rFound Is Nothing And rFound.Address <> MyAddress
        End If
    End With
 
    Set ws2 = ActiveWorkbook.Worksheets.Add
    i = 1
    For Each r In FindRange
        ws2.Cells(i, 1).Value = ws.Name & "!" & r.Address
        i = i + 1
    Next r
    ws2.Columns("A:A").AutoFit
    Application.ScreenUpdating = True
 
    Set ws = Nothing
    Set ws2 = Nothing
    Set r = Nothing
    Set rFound = Nothing
    Set FindRange = Nothing
 
End Sub