Excel VBA to check if value in a group of cells is not equal to 1

n0rv1n · Sep 17, 2010

Hi All,

There is a button in my worksheet which will allow user to proceed to computation worksheet.
I would like to create a code which will check the value of a group of cells Range("B2:D2,H2,J2,N2,R2,V2,X2,Z2,AB2,AD2.AF2,AH2,AN2,AP2:AX2").

If the value in any of these cells is equal to 1, message box will ask them to change the value and not allow user to proceed.

I tried with this code but it gives me error.

Code:

Sub Prem_Cal()

If Sheets("PS2010_Rel").Range("B2:D2,H2,J2,N2,R2,V2,X2,Z2,AB2,AD2.AF2,AH2,AN2,AP2:AX2") = 1 Then
        Warning = MsgBox("Please make sure the value is enterred correctly", vbOKOnly + vbCritical + vbDefaultButton1, "Discount Restriction")
        End
    End If

Range("A1").Select
    ActiveWorkbook.Unprotect "msigps10"
    Sheets("Prem").Visible = True
    Sheets("Prem").Activate
    Range("A1").Select
    Sheets("Main").Visible = False
    ActiveWorkbook.Protect "msigps10"
End Sub

Appreciate your guidance.

Thanks.

Norvin

Sandeep Warrier · Sep 17, 2010

Hi

How about something like

 Dim Rng As Range, NewRng As Range Set Rng = Range("B2:D2,H2,J2,N2,R2,V2,X2,Z2,AB2,AD2.AF2,AH2,AN2,AP2:AX2") With Rng Set NewRng = .Find(what:=1, after:=.Cells(1, .Columns.Count), lookat:=xlWhole) If Not NewRng Is Nothing Then 'Warning = ....... End If End With

Peter_SSs · Sep 17, 2010

If there could be several '1' cells then maybe find them all at once and advise the user.

 Sub Prem_Cal() Dim MyRng As Range, OneFound As Range, AllOnesFound As Range Dim FirstAddress As String Set MyRng = Range("B2:D2,H2,J2,N2,R2,V2,X2,Z2,AB2,AD2,AF2,AH2,AN2,AP2:AX2") With MyRng Set OneFound = .Find(What:=1, LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=False) If Not OneFound Is Nothing Then Set AllOnesFound = OneFound FirstAddress = OneFound.Address Do Set AllOnesFound = Union(AllOnesFound, OneFound) Set OneFound = .FindNext(After:=OneFound) Loop While OneFound.Address <> FirstAddress End If End With If AllOnesFound Is Nothing Then 'Proceed with other code here Else AllOnesFound.Select MsgBox "Please make sure the values are enterred correctly" & vbLf _ & "See selected cell(s): " & AllOnesFound.Address(0, 0) _ , vbOKOnly + vbCritical + vbDefaultButton1, "Discount Restriction" End If End Sub

n0rv1n · Sep 17, 2010

Hi All,

Thanks for your reply. Let me try it out.

Norvin

n0rv1n · Sep 17, 2010

Hi Peter,

The code works well.
One more question.
If the cell above every cell in the range that is being checked actually contain the definition of the cell, is possible to show that in the error message box instead of just showing the cell address?

Thank you.

Norvin

Peter_SSs said:
If there could be several '1' cells then maybe find them all at once and advise the user.

 Sub Prem_Cal() Dim MyRng As Range, OneFound As Range, AllOnesFound As Range Dim FirstAddress As String Set MyRng = Range("B2:D2,H2,J2,N2,R2,V2,X2,Z2,AB2,AD2,AF2,AH2,AN2,AP2:AX2") With MyRng Set OneFound = .Find(What:=1, LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=False) If Not OneFound Is Nothing Then Set AllOnesFound = OneFound FirstAddress = OneFound.Address Do Set AllOnesFound = Union(AllOnesFound, OneFound) Set OneFound = .FindNext(After:=OneFound) Loop While OneFound.Address <> FirstAddress End If End With If AllOnesFound Is Nothing Then 'Proceed with other code here Else AllOnesFound.Select MsgBox "Please make sure the values are enterred correctly" & vbLf _ & "See selected cell(s): " & AllOnesFound.Address(0, 0) _ , vbOKOnly + vbCritical + vbDefaultButton1, "Discount Restriction" End If End Sub

Peter_SSs · Sep 17, 2010

Try

 Sub Prem_Cal() Dim MyRng As Range, OneFound As Range, AllOnesFound As Range Dim FirstAddress As String, Defns As String Set MyRng = Range("B2:D2,H2,J2,N2,R2,V2,X2,Z2,AB2,AD2,AF2,AH2,AN2,AP2:AX2") With MyRng Set OneFound = .Find(What:=1, LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=False) If Not OneFound Is Nothing Then Set AllOnesFound = OneFound FirstAddress = OneFound.Address Do Defns = Defns & vbLf & OneFound.Offset(-1).Value Set AllOnesFound = Union(AllOnesFound, OneFound) Set OneFound = .FindNext(After:=OneFound) Loop While OneFound.Address <> FirstAddress End If End With If AllOnesFound Is Nothing Then 'Proceed with other code here Else AllOnesFound.Select MsgBox "Please make sure the values are enterred correctly" & vbLf _ & "See selected cell(s): " & AllOnesFound.Address(0, 0) & Defns _ , vbOKOnly + vbCritical + vbDefaultButton1, "Discount Restriction" End If End Sub

n0rv1n · Sep 17, 2010

Thanks Peter for your help

It is working.

Norvin

Excel VBA to check if value in a group of cells is not equal to 1

n0rv1n

New Member

Excel Facts

Sandeep Warrier

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

n0rv1n

New Member

n0rv1n

New Member

Peter_SSs

MrExcel MVP, Moderator

n0rv1n

New Member

Similar threads

Forum statistics

Share this page

Excel VBA to check if value in a group of cells is not equal to 1

n0rv1n

New Member

Excel Facts

Sandeep Warrier

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

n0rv1n

New Member

n0rv1n

New Member

Peter_SSs

MrExcel MVP, Moderator

n0rv1n

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock