Allow and Mark Selection Only If Condition is Met

Gos-C

Active Member
Joined
Apr 11, 2005
Messages
258
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi all,

I want to modify the following code to allow the user to select EG only if EE has PAID:


Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub

        If Not Intersect(Target, Range("EG2:EG" & Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing Then

            Target.Font.Name = "Marlett"

                If Target = vbNullString Then

                    Target = "a"

                Else

                    Target = vbNullString

                End If
        End If

End Sub
Any help, please?

Thank you,
Gos-C
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Hi Gos-C,
Does something like this help?
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Cells.Count > 1 _
   Or Intersect(Target, Range("EG2:EG" & Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing Then Exit Sub

If Target = vbNullString And Target.Offset(, -2).Value = "PAID" _
   Then Target.Font.Name = "Marlett": Target = "a"
End Sub
 
Upvote 0
Hi,

Maybe you can insert, after the

If Not Intersect(....

another condition like

Code:
If UCase(Cells(target.Row, "EE")) <> "PAID" Then Exit Sub

HTH

M.
 
Upvote 0
to allow the user to select EG only if EE has PAID
Add a change event handler (not forgetting to protect the sheet not allowing user to select locked cells):
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect userinterfaceonly:=True
Dim PaidRng As Range
Set PaidRng = Intersect(Target, Range("EE2:EE" & Cells(Rows.Count, 1).End(xlUp).Row))
If Not PaidRng Is Nothing Then
    For Each cll In PaidRng.Cells
        cll.Offset(, 2).Locked = Not (UCase(cll.Value) = "PAID")
    Next cll
End If
End Sub
 
Upvote 0
Marcelo's works! Thank you very much everyone.

Gos-C
 
Upvote 0
Hi all,

Can someone help me modify this code to include the following conditions:

When column EE has PAID and there is a duplicate record (i.e., there is another record where columns G, Q, AF are the same as those of the PAID record) but column EE of the duplicate record has PDVOID, that PDVOID record cancels the PAID record. Therefore, the PAID record is not eligible for selection

OR

When column EE has PAID but column EF (of the same record) has REVERSAL, that PAID record is not eligible for selection

Here is the current code:

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sRange As Range
Dim nResult As Long

            Set sRange = Range("EG2:EG" & Cells(Rows.Count, 1).End(xlUp).Row)
            If Target.Cells.Count > 1 _
            Or Intersect(Target, Range("EG2:EG" & Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing Then Exit Sub
                    If UCase(Cells(Target.Row, "EE")) <> "PAID" Then Exit Sub
                    
                            If Target = vbNullString Then
                                Target = "RK"
                            Else
                                Target = vbNullString
                            End If
            Range("EN2") = Application.WorksheetFunction.CountIf(sRange, "RK")
            If Range("EN2") >= Range("EM2") Then
            
            nResult = MsgBox( _
            Prompt:="You have already selected the minimum Risk Based Claims.  Do you want you want to select the Random Claims now?", _
            Buttons:=vbYesNo)
            If nResult = vbNo Then
            Exit Sub
            Else
            MsgBox "Please run the Random_Claims_Selection macro."
            End If
            End If
            Application.ScreenUpdating = True

End Sub

Thank you,
Gos-C
 
Upvote 0
Hi all,

I am still unable to prevent a user from selection the Paid record as described below:

When column EE has PAID and there is a duplicate record (i.e., there is another record where columns G, Q, AF are the same as those of the PAID record) but column EE of the duplicate record has PDVOID, that PDVOID record cancels the PAID record. Therefore, the PAID record is not eligible for selection.

Any help, please?

Thank you,
Gos-C
 
Upvote 0
Hi all,

I discovered that a PDVoid record and the Paid record that it cancelled would have the same string (a number) in column BA. Therefore, when a record is marked Paid in column EE and the number in column BA appears more than once in that column, that Paid record is not eligible for selection.

I need to modify the following code to prevent a user from selection a Paid record whose value in column BA appears more that once in that column:

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sRange As Range
Dim nResult As Long

            Set sRange = Range("EG2:EG" & Cells(Rows.Count, 1).End(xlUp).Row)
            If Target.Cells.Count > 1 _
            Or Intersect(Target, Range("EG2:EG" & Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing Then Exit Sub
                    If UCase(Cells(Target.Row, "EE")) <> "PAID" Then Exit Sub
                    
                            If Target = vbNullString Then
                                Target = "RK"
                            Else
                                Target = vbNullString
                            End If
            Range("EN2") = Application.WorksheetFunction.CountIf(sRange, "RK")
            If Range("EN2") >= Range("EM2") Then
            
            nResult = MsgBox( _
            Prompt:="You have already selected the minimum Risk Based Claims.  Do you want you want to select the Random Claims now?", _
            Buttons:=vbYesNo)
            If nResult = vbNo Then
            Exit Sub
            Else
            MsgBox "Please run the Random_Claims_Selection macro."
            End If
            End If
            Application.ScreenUpdating = True

End Sub

Any help, please?

Thank you,
Gos-C
 
Upvote 0
Hi all,

I have tried the following:

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sRange As Range
Dim nResult As Long
Dim tRange As Range
Dim x As Double
Dim LastRow As Integer
Dim DupCheck As String

            Set sRange = Range("EG2:EG" & Cells(Rows.Count, 1).End(xlUp).Row)
            Set tRange = Range("BA2:BA" & Cells(Rows.Count, 1).End(xlUp).Row)
            
            For x = 2 To LastRow
            LastRow = ActiveSheet.Cells(Rows.Count, 1).End.Row
            DupCheck = Application.WorksheetFunction.CountIf(Range(tRange, "BA" & x))

            Next x
            
            If Target.Cells.Count > 1 _
            Or Intersect(Target, Range("EG2:EG" & Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing Then Exit Sub
                    If UCase(Cells(Target.Row, "EE")) <> "PAID" Or (UCase(Cells(Target.Row, "EE")) = "PAID" And UCase(Cells(Target.Row, "EF")) = "REVERSAL") _
                    Or (UCase(Cells(Target.Row, "EE")) = "PAID" And DupCheck > 1) Then Exit Sub
                    
                            If Target = vbNullString Then
                                Target = "RK"
                            Else
                                Target = vbNullString
                            End If
            Range("EN2") = Application.WorksheetFunction.CountIf(sRange, "RK")
            If Range("EN2") >= Range("EM2") Then
            
            nResult = MsgBox( _
            Prompt:="You have already selected the minimum Risk Based Claims.  Do you want you want to select the Random Claims now?", _
            Buttons:=vbYesNo)
            If nResult = vbNo Then
            Exit Sub
            Else
            MsgBox "Please run the Random_Claims_Selection macro."
            End If
            End If
            Application.ScreenUpdating = True

End Sub

But I get Run-time error '13': Type mismatch at the following:

Code:
If UCase(Cells(Target.Row, "EE")) <> "PAID" Or (UCase(Cells(Target.Row, "EE")) = "PAID" And UCase(Cells(Target.Row, "EF")) = "REVERSAL") _
                    Or (UCase(Cells(Target.Row, "EE")) = "PAID" And DupCheck > 1) Then

Can someone help me, please.

Thank you,
Gos-C
 
Upvote 0

Forum statistics

Threads
1,224,527
Messages
6,179,331
Members
452,907
Latest member
Roland Deschain

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top