How to use VBA to open input box of cell contains 0 and replace with value (variable) entered in a column

[Shjph]

Hi I have written a macro below the checks for 0 in column AE and if it finds it opens an input box to enter a number over 0. This then replace the cell with the value entered.
However due to my limited knowledge I can only do it with one specific cell. Is there a way I can get it to check cells one by one in a column.
I.e start at cell AE1 going down the colours and check for cells containing 0. Then prompting input box each time a cell meeting this criteria is meet.
Below is my current macro.

Sub ENTER_VALUE()
Dim FileImport As String
Dim AnsBool As Boolean

AnsBool = True

If Range("AH11") = 0 Then

FileImport = InputBox("MISSING INVOICE AMOUNT, Please Provide Amount")

Do While AnsBool
If StrPtr(FileImport) = 0 Then Exit Sub
If FileImport <> "" Then Exit Do
MsgBox "Please Provide Reasoning"
FileImport = InputBox("MISSING INVOICE AMOUNT, Please Provide Amount")
Loop
End If

'You can change this to the range needed
Range("AH11").Value = FileImport

End Sub

 

[dmt32]

Hi,
welcome to forum

See if this update to your code does what you want

Sub ENTER_VALUE()
    Dim FileImport  As Variant
    Dim rng         As Range, fnd As Range
   
    Const Prompt As String = "MISSING INVOICE AMOUNT"
   
    'search range
    Set rng = Range(Range("AE2"), Range("AE" & Rows.Count).End(xlUp))

    Do
        Set fnd = rng.Find(0, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            fnd.Select
            FileImport = InputBox(Prompt, "Please Provide Amount")
            'cancel pressed
            If StrPtr(FileImport) = 0 Then Exit Sub
            'inform user
            If Val(FileImport) = 0 Then MsgBox Prompt & Chr(10) & _
                                       "Please Provide Amount", 48, "Entry Required"
            'update range
            fnd.Value = Val(FileImport)
        End If
    Loop Until fnd Is Nothing
   
End Sub

I have assumed that the sheet being updated is the Activesheet

Dave

 

[Shjph]

Hi,
welcome to forum

See if this update to your code does what you want

Sub ENTER_VALUE()
    Dim FileImport  As Variant
    Dim rng         As Range, fnd As Range
  
    Const Prompt As String = "MISSING INVOICE AMOUNT"
  
    'search range
    Set rng = Range(Range("AE2"), Range("AE" & Rows.Count).End(xlUp))

    Do
        Set fnd = rng.Find(0, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            fnd.Select
            FileImport = InputBox(Prompt, "Please Provide Amount")
            'cancel pressed
            If StrPtr(FileImport) = 0 Then Exit Sub
            'inform user
            If Val(FileImport) = 0 Then MsgBox Prompt & Chr(10) & _
                                       "Please Provide Amount", 48, "Entry Required"
            'update range
            fnd.Value = Val(FileImport)
        End If
    Loop Until fnd Is Nothing
  
End Sub

I have assumed that the sheet being updated is the Activesheet

Dave

Thank you so much this worked perfectly

 

[dmt32]

Thank you so much this worked perfectly

most welcome & appreciate your feedback

Dave

 

[Shjph]

most welcome & appreciate your feedback

Dave

Hi Dave is it possible to add cell information into the input box,

For instance if macro finds 0 in cell AE11 the input box references the information from cell F11 in the wording . I have

 

[dmt32]

Hi Dave is it possible to add cell information into the input box,

For instance if macro finds 0 in cell AE11 the input box references the information from cell F11 in the wording . I have

Hi,
you can include cell address where shown in BOLD

Sub ENTER_VALUE()
    Dim FileImport  As Variant
    Dim rng         As Range, fnd As Range
    
    Const Prompt As String = "MISSING INVOICE AMOUNT"
    
    'search range
    Set rng = Range(Range("AE2"), Range("AE" & Rows.Count).End(xlUp))

    Do
        Set fnd = rng.Find(0, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            fnd.Select
            FileImport = InputBox(Prompt & Chr(10) & fnd.Address, "Please Provide Amount")
            'cancel pressed
            If StrPtr(FileImport) = 0 Then Exit Sub
            'inform user
            If Val(FileImport) = 0 Then MsgBox Prompt & Chr(10) & _
                                       "Please Provide Amount", 48, "Entry Required"
            'update range
            fnd.Value = Val(FileImport)
        End If
    Loop Until fnd Is Nothing
   
End Sub

Dave