Excel VBA code question
Solved/Closed
Michael

May 6, 2010 at 03:22 AM
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022  May 8, 2010 at 02:29 PM
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022  May 8, 2010 at 02:29 PM
Related:
 Excel VBA code question
 Convert number to words in excel vba code  Guide
 Dealing with 'Today()' formula in Excel VBA code ✓  Forum  Excel
 Excel vba code to change cell color based on value ✓  Forum  Programming
 VBA macro to color a range of cells based on value of other cell  Forum  Excel
 Vba code to search data in excel  Guide
3 replies
The user will change this value in the excel spreadsheet.
The reset of the other numbers will occur when the user run the macro. The macro code outline in my post.
The reset of the other numbers will occur when the user run the macro. The macro code outline in my post.
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
768
May 6, 2010 at 04:01 PM
May 6, 2010 at 04:01 PM
Who would be changing this value ? Does this reset of numbers has be occur by its own ?
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 to allow better understanding of how it is now and how you foresee.
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 to allow better understanding of how it is now and how you foresee.
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
768
May 8, 2010 at 01:18 PM
May 8, 2010 at 01:18 PM
Assumption.
1. The adjustment will be done on all cell except for the one which caused the change
2. Sum formula is below the range on which the sum formula is based upon
Steps
1. Press ALT + F11 to open VBE
2. Press CTRL + R to open the project explorer
3. Double click on the sheet
4. Paste the code
1. The adjustment will be done on all cell except for the one which caused the change
2. Sum formula is below the range on which the sum formula is based upon
Steps
1. Press ALT + F11 to open VBE
2. Press CTRL + R to open the project explorer
3. Double click on the sheet
4. Paste the code
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
Thanks. It works fine, however the calculation math need to be change  the code above add equal value to each cell. However, I need the cells to change proportionally to their values using the following math:
For example, if the first excel cell is changed by user from 10 to 20:
20
30
20
40
110
The automatic result by code will be:
20
30/(11020)*(10020)=26.67
20/(11020)*(10020)=17.77
40/(11020)*(10020)=35.55
100
Please post code reflecting the math above. Thanks.
For example, if the first excel cell is changed by user from 10 to 20:
20
30
20
40
110
The automatic result by code will be:
20
30/(11020)*(10020)=26.67
20/(11020)*(10020)=17.77
40/(11020)*(10020)=35.55
100
Please post code reflecting the math above. Thanks.
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
768
May 8, 2010 at 02:29 PM
May 8, 2010 at 02:29 PM
You just need to change this line to fit your requirement
Cells(lFixRow, Target.Column) = Cells(lFixRow, Target.Column) + (vLastDiff / (lEndRow  lStartRow))
Cells(lFixRow, Target.Column) = Cells(lFixRow, Target.Column) + (vLastDiff / (lEndRow  lStartRow))
May 7, 2010 at 09:24 AM
May 7, 2010 at 10:05 AM
Thanks.
May 7, 2010 at 10:20 AM
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
May 7, 2010 at 10:51 AM
https://authentification.site/files/22317946/sample_percentage_.xls
I will appreciate the vba code. Thanks.