Excel Vba Code to Check Quantity in a Column - excel

Question

I have a macro to format a spreadsheet. I need some excel vba code to add to the start to check that the Quantity in a column is always '1'
The code needs to check the column from cell H2 to the bottom of the data in H2 (until it finds a blank cell).
If all the values are '1' do nothing and continue running the macro. If it finds any other number (either negative or positive) display a MsgBox "Warning: Quantities Other Than '1' Found. Fix Errors and Re-Run!" then when 'OK' is selected exit the macro.

Answer 1

Something like this:
Sub YourExistingCode()
If QuantityErrorFound Then
MsgBox "Warning: Quantities Other Than '1' Found. Fix Errors and Re-Run!"
Exit Sub
Else
'~~> Run your code
End If
End Sub
Function QuantityErrorFound() As Boolean
Dim cl As Range, result As Boolean
result = False
For Each cl In Range("H2:H" & Range("H2").End(xlDown).Row)
If cl.Value <> 1 Then
result = True
End If
Next cl
QuantityErrorFound = result
End Function
I've used a function (QuantityErrorFound) to make it easier to integrate into your existing code
In your existing code simply add the if statement to check whether an error is found

Answer 2

Just a slight change to Alex P's code really. As you're dealing with 1s a simple sum will be quicker than a loop
Function QuantityErrorFound() As Boolean
Dim result As Boolean
Dim lastR as long
Dim sumCells as long
Dim cntCells as Long
result = False
'lastR = Range("H2").End(xlDown).Row
lastR= Cells(rows.count, Range("H2").Column).End(Excel.xlUp).Row '<< assuming below the last cell is empty then this is a better approach to above line.
sumCells = Excel.Application.Sum(Range("H2:H" & lastR))
cntCells = Range("H2:H" & lastR).cells.count
if (sumCells = cntCells) then
result = True
end if
QuantityErrorFound = result
End Function
Personally in my work spreadsheets I would use a formula in a hidden cell (named range called "ErrorCheck") like this:
=if(countif(H2:H10000,"<>1")>0,"error","ok")
Then in my vba all I need is the following:
if ((range("ErrorCheck") = "error") then
MsgBox "Warning: Quantities Other Than '1' Found. Fix Errors and Re-Run!"
else
...
...
Edit
Please see flaw in my check as pointed out by Ian Cook. I will leave the code as is - but you should force values in column H to be either 1 or 0 if using the above. This could be done with a simple formula:
=if(<current formula>=1,1,0)
or
=1*(<current formula>=1)
Or, defend Ian's possible problem, by changing the Sum in my vba to a countIf:
Function QuantityErrorFound() As Boolean
Dim result As Boolean
Dim lastR as long
Dim sumCells as long
Dim cntCells as Long
result = False
'lastR = Range("H2").End(xlDown).Row
lastR= Cells(rows.count, Range("H2").Column).End(Excel.xlUp).Row '<< assuming below the last cell is empty then this is a better approach to above line.
sumCells = Excel.Application.WorksheetFunction.CountIf(Range("H2:H" & lastR),"=1") '<<not tested and may need to read ...,1)
cntCells = Range("H2:H" & lastR).cells.count
if (sumCells = cntCells) then
result = True
end if
QuantityErrorFound = result
End Function
Then again if using the above it could be simplified to the following:
Function QuantityErrorFound() As Boolean
Dim result As Boolean
Dim lastR as long
Dim sumCells as long
result = False
lastR= Cells(rows.count, Range("H2").Column).End(Excel.xlUp).Row
sumCells = Excel.Application.WorksheetFunction.CountIf(Range("H2:H" & lastR),"<>1")
if (sumCells = 0) then
result = True
end if
QuantityErrorFound = result
End Function