Having problems with a simple macro

[dan345]

Hi,

I was wondering if you could help on this problem im having. basically, i creating a very simple macro to allow the user to pick a range and count for the number of blank cells and then replace the selected range of blank cells with 0.

here is my code so far. at this moment, my code can select the range and count for blank cells, however, it cannot fill the selected range of blank cells to 0. what it does is turns all the nearest blanks cells to 0 or even outside the range.

Sub miss1()

On Error GoTo ErrorHandler

Dim Answer As String
Dim MyNote As String
Dim Holder As Object
Dim Answer2 As Integer

Set Holder = _
Application.InputBox("Input or highlight the range to check for blanks", _
"Blank Cell Counter", Type:=8)

' Set the counter to 0.
Answer2 = 0

' Count each blank cell.
For Each x In Holder
If IsEmpty(x.Value) Then Answer2 = Answer2 + 1
Next x

' Displays answer in a message box.
MsgBox "There are " & Answer2 & " blank cell(s) in this range."

Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "WARNING")

If Answer = vbNo Then
MsgBox "Missing values have been highlighted but have not been replaced!"
Else

MyNote = "Since missing values have been found, Do you want to replace?"
Range("").SpecialCells(xlCellTypeBlanks).Value = 0

End If

Exit Sub

ErrorHandler:

MsgBox "No missing data was found!"

End Sub

thanks

 

[dan345]

Sorry, I don't understand.

for example, where it says replace with? vbyes or no, if the user selects no, it will execute the message "no missing cells found", instead of this i just want it to highlight the empty cells found with yellow.

 

[VoG]

Try

Sub miss1()
Dim r As range, x
On Error Resume Next
Set r = Application.InputBox("Select the range", Type:=8)
If r Is Nothing Then Exit Sub
On Error GoTo 0
x = WorksheetFunction.CountBlank(r)
If x > 0 Then
    If MsgBox("Range contains " & x & " blanks" & vbNewLine & "Replace with ?", vbQuestion + vbYesNo) = vbYes Then
        With r.SpecialCells(xlCellTypeBlanks)
            .Value = InputBox("Enter value")
            .Interior.ColorIndex = 6
        End With
    Else
        r.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 6
    End If
Else
    MsgBox "No blanks found", vbInformation
End If
End Sub

 

[dan345]

[/code]

Thanks again