Code for rows of cells returning reverse-order values.

W

Worksong

New Member
Joined
Mar 23, 2024
Messages
21
Office Version
  1. 365
Platform
  1. Windows
Hello all, I'm trying to adapt code from a worksheet in which clicking in cells return specific values across columns, for example, in any row column E returns 3, column F returns 2, etc. I'm trying to come up with code that will work when some rows are scored forwards and some in reverse: columns E-H return 3-0 (0 remains a blank cell), respectively, in the forward condition - E=3, F=2, etc.; while the reverse rows return 0-3: E=blank, F=1, etc.

I've been able to successfully adapt the original code for one condition or the other, but not both. I'm haven't been able to find the right syntax to combine both conditions into one set of code. In the attached picture, the white/grey rows E-H should return 3/2/1/blank, while the red rows E-H should return blank/1/2/3. Thanks in advance!

Forward condition code (white/grey cells):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge = 1 And Not
Intersect(Range(“E15:H18,E20:H23,E25:H30,E32:H35,E37:H38,E40:H45,E47:H49,E51:H55,E57:H59,E62:H65,E67:H70,E72:H74,E76:H80,E82:H84,E86:H89,E91:H93”), Target) Is Nothing Then
On Error GoTo Escape
Application.EnableEvents = False

Select Case Target.Column
Case Is = 5: Target = 3 - Target
Case Is = 6: Target = 2 - Target
Case Is = 7: Target = 1 - Target
End Select

End If
Continue:
Application.EnableEvents = True
Exit Sub

Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue
End Sub



Reverse Condition (red cells):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge = 1 And Not
Intersect(Range(“E14:H14,E19:H19,E24:H24,E31:H31,E36:H36,E39:H39,E46:H46,E50:H50,E56:H56,E60:H61,E66:H66,E71:H71,E75:H75,E81:H81,E85:H85,E90:H90”), Target) Is Nothing Then
On Error GoTo Escape
Application.EnableEvents = False

Select Case Target.Column
Case Is = 6: Target = 1 - Target
Case Is = 7: Target = 2 - Target
Case Is = 8: Target = 3 - Target
End Select

End If
Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue
End Sub
 

Attachments

  • RAADS-R snapshot.JPG
    RAADS-R snapshot.JPG
    105 KB · Views: 12

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
@Worksong Assuming I haven't made any silly error with rows then perhaps give this a try....

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
If Not (Target.Column > 4 And Target.Column < 9) Then Exit Sub
If Not (Target.Row > 13 And Target.Column < 94) Then Exit Sub

On Error GoTo Escape
Application.EnableEvents = False
Select Case Target.Row
Case 14, 19, 24, 31, 36, 39, 46, 50, 56, 60, 61, 66, 71, 75, 81, 85, 90
Target = Target.Column - 5
Case Else
Target = Abs(Target.Column - 8)
End Select
Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue

End Sub
Hope that helps?
 
Upvote 1
Another option...
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("E14:H93"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Select Case Target.Row
            Case 14, 19, 24, 31, 36, 39, 46, 50, 56, 60, 61, 66, 71, 75, 81, 85, 90
                Select Case Target.Column
                    Case Is = 5: If Target = "0" Then Target = "" Else Target = 0
                    Case Is = 6: Target = 1 - Target
                    Case Is = 7: Target = 2 - Target
                    Case Is = 8: Target = 3 - Target
                End Select
            Case Else
                Select Case Target.Column
                    Case Is = 5: Target = 3 - Target
                    Case Is = 6: Target = 2 - Target
                    Case Is = 7: Target = 1 - Target
                    Case Is = 8: If Target = "0" Then Target = "" Else Target = 0
                End Select
        End Select
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 1
On the assumption that you likely only want to return a single answer per row then maybe try the below.

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Cells.CountLarge > 1 Then Exit Sub
If Intersect(Range("E14:H93"), Target) Is Nothing Then Exit Sub

Dim trow As Integer
trow = Target.Row
'clear any previous entry for the row ????
Range("E" & trow & ":H" & trow).ClearContents

On Error GoTo Escape
Application.EnableEvents = False
Select Case trow
Case 14, 19, 24, 31, 36, 39, 46, 50, 56, 60, 61, 66, 71, 75, 81, 85, 90
Target = Target.Column - 5
Case Else
Target = Abs(Target.Column - 8)
End Select
Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue

End Sub
 
Upvote 1
Solution
kevin9999 said:
Another option...
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("E14:H93"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Select Case Target.Row
            Case 14, 19, 24, 31, 36, 39, 46, 50, 56, 60, 61, 66, 71, 75, 81, 85, 90
                Select Case Target.Column
                    Case Is = 5: If Target = "0" Then Target = "" Else Target = 0
                    Case Is = 6: Target = 1 - Target
                    Case Is = 7: Target = 2 - Target
                    Case Is = 8: Target = 3 - Target
                End Select
            Case Else
                Select Case Target.Column
                    Case Is = 5: Target = 3 - Target
                    Case Is = 6: Target = 2 - Target
                    Case Is = 7: Target = 1 - Target
                    Case Is = 8: If Target = "0" Then Target = "" Else Target = 0
                End Select
        End Select
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
[/
[/QUOTE]
[QUOTE="kevin9999, post: 6169427, member: 465570"]
Another option...
[CODE=vba]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("E14:H93"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Select Case Target.Row
            Case 14, 19, 24, 31, 36, 39, 46, 50, 56, 60, 61, 66, 71, 75, 81, 85, 90
                Select Case Target.Column
                    Case Is = 5: If Target = "0" Then Target = "" Else Target = 0
                    Case Is = 6: Target = 1 - Target
                    Case Is = 7: Target = 2 - Target
                    Case Is = 8: Target = 3 - Target
                End Select
            Case Else
                Select Case Target.Column
                    Case Is = 5: Target = 3 - Target
                    Case Is = 6: Target = 2 - Target
                    Case Is = 7: Target = 1 - Target
                    Case Is = 8: If Target = "0" Then Target = "" Else Target = 0
                End Select
        End Select
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Click to expand...
Thanks @kevin9999! This works great. It does, though, change the value in a cell each time you click that cell - not sure if that was intentional or not. If so, I apologize for not being clearer in the OG post. And @Snakehips read my mind - I did want each row to only accept one answer but neglected to note that in the OG post.
kevin9999 said:
Another option...
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("E14:H93"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Select Case Target.Row
            Case 14, 19, 24, 31, 36, 39, 46, 50, 56, 60, 61, 66, 71, 75, 81, 85, 90
                Select Case Target.Column
                    Case Is = 5: If Target = "0" Then Target = "" Else Target = 0
                    Case Is = 6: Target = 1 - Target
                    Case Is = 7: Target = 2 - Target
                    Case Is = 8: Target = 3 - Target
                End Select
            Case Else
                Select Case Target.Column
                    Case Is = 5: Target = 3 - Target
                    Case Is = 6: Target = 2 - Target
                    Case Is = 7: Target = 1 - Target
                    Case Is = 8: If Target = "0" Then Target = "" Else Target = 0
                End Select
        End Select
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Click to expand...
 
Upvote 0
kevin9999 said:
Another option...
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("E14:H93"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Select Case Target.Row
            Case 14, 19, 24, 31, 36, 39, 46, 50, 56, 60, 61, 66, 71, 75, 81, 85, 90
                Select Case Target.Column
                    Case Is = 5: If Target = "0" Then Target = "" Else Target = 0
                    Case Is = 6: Target = 1 - Target
                    Case Is = 7: Target = 2 - Target
                    Case Is = 8: Target = 3 - Target
                End Select
            Case Else
                Select Case Target.Column
                    Case Is = 5: Target = 3 - Target
                    Case Is = 6: Target = 2 - Target
                    Case Is = 7: Target = 1 - Target
                    Case Is = 8: If Target = "0" Then Target = "" Else Target = 0
                End Select
        End Select
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Click to expand...
Sorry for the multiple replies - I'm still learning to navigate this board. That said, all replies are true, I had just intended for them to be a single Reply. I'm a freakin' newb...:ROFLMAO:
 
Upvote 0
You must log in or register to reply here.

Similar threads

Q
  • Solved
Excel existing code flaw
2
Replies
11
Views
205
MARK858
MARK858
B
  • Solved
Worksheet Change - multiple Loops in one sub
2
Replies
15
Views
812
mumps
mumps
J
  • Question Question
Copying Rows Based on Column Value
Replies
1
Views
80
jolivanes
jolivanes
J
  • Question Question
A VBA Code to Transfer rows of cells across Sheets based on Certain Column Value
Replies
2
Views
115
Peter_SSs
Peter_SSs
H
  • Question Question
Error 1004: Copy method of Range class failed
Replies
2
Views
409
Alex Blakenburg
A

Forum statistics

Threads
1,223,893
Messages
6,175,246
Members
452,623
Latest member
cliftonhandyman

Share this page

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