Deleting values inside cells

user_17182681 0
Viewed 43

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 enter image description here 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.

vba excel
1 Answers

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
user_98140690
Related