Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Dim oldValue As Double
    Dim newValue As Double
    Dim oldSum As Double
    Dim delta As Double
    Dim maxRows As Integer
    
    ' Set this to the number of rows you are summing to 100%
    maxRows = 8

    If Not IsNumeric(Target.Value) Then Exit Sub
    If Target.Count > 1 Then Exit Sub
        
    Application.EnableEvents = False
    
    ' get old Value
    newValue = Target.Value
    Application.Undo
    oldValue = Target.Value
    Target.Value = newValue
    
    ' Get the sum before the change
    For i = 1 To maxRows
        If i <> Target.Row Then
            oldSum = oldSum + Me.Cells(i, Target.Column)
        End If
        
    Next
    
    ' Don't start recalulating until we hit 100%
    If oldSum + oldValue < 1 Then
          Application.EnableEvents = True
        Exit Sub
    End If
    
    ' Figure out how much the other cells need to change by
    If oldSum <> 0 Then
        delta = (1 - Target.Value) / (1 - (1 - oldSum))
    Else
        delta = 0
    End If
    
    ' update all the other cells
    For i = 1 To maxRows
        If i <> Target.Row Then
            Me.Cells(i, Target.Column) = Me.Cells(i, Target.Column) * delta
        End If
        
    Next

    Application.EnableEvents = True
    
End Sub