Calculate % and value vice versa

[Jobsan]

Hello guys,

Sorry to bother you I was wondering if there VBA that can calculate value just by percentage and percentage base on value. So basically being able to to calculate vice versa. If I overwrite the value of one the other will update. Ive attached a screenshot. I would like to be able to do that for column E and Column H on the whole workbook. Thank you!!

 

[Kaper]

Right click on tab with sheet name, Use "View Code". In VBA Editor window which shall show up, paste the code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, curr_row As Long
If Not Intersect(Target, Range("E5:E1000,H5:H1000")) Is Nothing Then
  For Each rng In Intersect(Target, Range("E5:E1000,H5:H1000"))
    curr_row = rng.Row
    If IsNumeric(Cells(curr_row, "C").Value) And IsNumeric(rng.Value) And Cells(curr_row, "C").Value > 0 Then
      Application.EnableEvents = False
        If rng.Column = 5 Then 'change in E
          Cells(curr_row, "H") = rng.Value / Cells(curr_row, "C").Value
        Else 'it is H column
          Cells(curr_row, "E") = rng.Value * Cells(curr_row, "C").Value
        End If
      Application.EnableEvents = True
    End If
  Next rng
End If
End Sub

close VBA editor window, Make sure that column H is formatted as percents, and file is saved in macro-enabled format (like xlsm) and test it.

Book1
	A	B	C	D	E	F	G	H
1
2
3
4
5
6								50%
7			1200		1200			100%
8			a		100
9			1500		900			60%
10			2000		1000			50%
Sheet1

 

[Jobsan]

Thank you so much!!! ive been scratching my head all this time. one more thing, lets say i have thew same information but 10 more taps. What can i do do make it do the same in all the following workbook

 

[Kaper]

And all sheets has the same layout?

Then you have 2 main options:
First:
simple, but not elegant - copy the code to every sheet which shall work that way.

Second:
View the code again, delete it, dont close VBA editor window..
Doubleclick on Thisworkbook element which shall be visible in a window on the left. And in a code window on the right paste such code.
In a code include a list of all names of sheets, where code shall not be executed. If it is only SOV sheet, then leave it as is. The list shall have at least 2 elements to work properly, and it does not hurt if you don't have sheet named Name_of_any_other_Sheet_not_working_that_way in your workbook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rng As Range, curr_row As Long, lista As Variant
lista = Split("SOV,Name_of_any_other_Sheet_not_working_that_way", ",") ' make a comma separated list of sheets excluded from such procedure
If Not IsError(Application.Match(Sh.Name, lista, 0)) Then Exit Sub 'do nothing/exit if current sheet is on that list
'here the same code as previously used
If Not Intersect(Target, Range("E5:E1000,H5:H1000")) Is Nothing Then
  For Each rng In Intersect(Target, Range("E5:E1000,H5:H1000"))
    curr_row = rng.Row
    If IsNumeric(Cells(curr_row, "C").Value) And IsNumeric(rng.Value) And Cells(curr_row, "C").Value > 0 Then
      Application.EnableEvents = False
        If rng.Column = 5 Then 'change in E
          Cells(curr_row, "H") = rng.Value / Cells(curr_row, "C").Value
        Else 'it is H column
          Cells(curr_row, "E") = rng.Value * Cells(curr_row, "C").Value
        End If
      Application.EnableEvents = True
    End If
  Next rng
End If
End Sub

 

[Jobsan]

Thank you so much!!!!