Private Sub Worksheet_Change(ByVal Target As Range) Dim lSumRow As Long ' row on which sum formula is Dim vFormula As Variant ' sum formula Dim sStartRange As String ' start range of sum formula Dim sEndRange As String ' end range of sum formula Dim lStartRow As Long ' sum start at this row Dim lEndRow As Long 'sum end at this for Dim lFixRow As Long ' row to be fixed Dim vLastDiff As Variant ' difference in current Sum and 100 ' if change did not happen in column D, then exit If Target.Column <> 4 Then Exit Sub On Error GoTo End_Sub Application.EnableEvents = False On Error Resume Next ' find where the sum formula is lSumRow = 0 lSumRow = Range(Target, Cells(Rows.Count, Target.Column)).Find("=Sum(", Target, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Row On Error GoTo End_Sub ' change from 100 vLastDiff = 100 - Cells(lSumRow, Target.Column) ' if difference is blank or zero If ((vLastDiff = "") Or (vLastDiff = 0)) Then GoTo End_Sub 'sum formula vFormula = Cells(lSumRow, Target.Column).Formula ' if there is a sum formula If (vFormula <> "") Then 'get the start range and end range If (InStr(1, vFormula, ":") > 0) Then sStartRange = Left(vFormula, InStr(1, vFormula, ":") - 1) sStartRange = Mid(sStartRange, 6) lStartRow = Range(sStartRange).Row sEndRange = Mid(vFormula, InStr(1, vFormula, ":") + 1) sEndRange = Mid(sEndRange, 1, Len(sEndRange) - 1) lEndRow = Range(sEndRange).Row Else sStartRange = Mid(vFormula, 6) sStartRange = Mid(vFormula, 1, Len(sStartRange) - 1) lStartRow = Range(sStartRange).Row lEndRow = Range(sStartRange).Row End If ' if the row that is changed is included in the sum formula If ((lStartRow <= Target.Row) And (lEndRow >= Target.Row)) Then If (lEndRow - lStartRow > 0) Then For lFixRow = lStartRow To lEndRow If (lFixRow = Target.Row) Then GoTo Next_lFixRow Cells(lFixRow, Target.Column) = Cells(lFixRow, Target.Column) + (vLastDiff / (lEndRow - lStartRow)) Next_lFixRow: Next lFixRow End If End If End If End_Sub: Application.EnableEvents = True End Sub
DON'T MISS
Thanks.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
The Worksheet_SelectionChange event is triggered when a cell is clicked. So as soon as it is clicked you store that value
The Worksheet_Change event is then triggered if a cell value is change manually
and there you will adjust the numbers
Could you please upload a sample file with sample data etc on some shared site like https://authentification.site and post back here the link
https://authentification.site/files/22317946/sample_percentage_.xls
I will appreciate the vba code. Thanks.