I have a spreadsheet for inserting values of scores of different teams. Column A has the team names and column B has their scores. The same goes for column C and D. There are 10 teams with 5 in Column A and C. My goal is to code when you enter a score for a team it goes two to the right and when you enter that value, it goes down one and left two. I had that working before, but I had to implement one more thing, and it stopped working. I had to implement that when an invalid score is entered, a non-number, negative number, etc. it would delete itself. I am not sure what I did wrong or what may have led me in the wrong direction.
Here's What I Have
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TeamScore2 As Integer
Dim TeamScore4 As Integer
Select Case Target.Column
Case 2: Target.Offset(0, 2).Select
Case 4: Target.Offset(1, -2).Select
End Select
TeamScore2 = ActiveCell.Offset(0, 2).Value
TeamScore4 = ActiveCell.Offset(1, -2).Value
If TeamScore2 <= -1 Then
ActiveCell.Value = ""
End If
If TeamScore4 <= -1 Then
ActiveCell.Value = ""
End If
End Sub
image of spreadsheet final statments
I declared two integers and when the selected cell depending on the offset, either (0, 2) or (1, -2) was less than or equal to -1 then the value should be "". Also, I am not sure how I would implement the case that the value is a string. Also, someone said this question was already answered with a link, but I was not able to interpret it as its idea was different than my intentions.
CodePudding user response:
A Worksheet Change: Teams and Scores
In cell
B8
you could use something like=IF(COUNT(B3:B7,D3:D7)=10,"Yes","No")
The Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const rgAddress As String = "B3:B7,D3:D7"
Const MinNum As Long = 0
Const MaxNum As Long = 100
Dim srg As Range: Set srg = Range(rgAddress)
Dim irg As Range: Set irg = Intersect(srg, Target)
If irg Is Nothing Then Exit Sub
Dim iCell As Range
Dim ValidCell As Range
Dim InvalidCells As Range
Dim iValue As Variant
Dim IsValid
For Each iCell In irg.Cells
iValue = iCell.Value
If VarType(iValue) = vbDouble Then ' number
If iValue = Int(iValue) Then ' whole number
If iValue >= MinNum And iValue <= MaxNum Then ' in range
Set ValidCell = iCell
IsValid = True
End If
End If
End If
If IsValid Then
IsValid = False
Else
If InvalidCells Is Nothing Then
Set InvalidCells = iCell
Else
Set InvalidCells = Union(InvalidCells, iCell)
End If
End If
Next iCell
If InvalidCells Is Nothing Then
Dim ColOffset As Long
ColOffset = srg.Areas(2).Column - srg.Areas(1).Column
If Intersect(ValidCell, srg.Areas(1)) Is Nothing Then
ValidCell.Offset(1, -ColOffset).Select
Else
ValidCell.Offset(, ColOffset).Select
End If
Else
Application.EnableEvents = False
InvalidCells.Value = Empty
Application.EnableEvents = True
InvalidCells.Cells(1).Select
End If
End Sub