hecgroups
03-10-2012, 10:58 AM
Hello,
I an seeking a help to amendment in a VBA Macros. This micros written by one of my friend. But now the problem is below mentioned script is working for columns C,D & F only.
What i need here is Same calculation also work for columns I, J, L,P, Q, S, V,W Y.
Can anyone help me to resolve this issue please.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim keyRange As Range, changedRange As Range
Dim oneArea As Range, oneRow As Range
Dim Dent As Double, Lim As Double, newLim As Double
Dim Pct As Variant, Increase As Variant, Differential As Variant
Set keyRange = Range("C:C,D:D,F:F")
Set changedRange = Application.Intersect(keyRange.EntireColumn, Target)
If Not changedRange Is Nothing Then
On Error GoTo ErrorOut
Application.EnableEvents = False
With changedRange
For Each oneArea In .Areas
With oneArea
For Each oneRow In oneArea.Rows
With oneRow.EntireRow
Dent = Val(CStr(.Range("c1")))
Lim = Val(CStr(.Range("d1")))
newLim = Val(CStr(.Range("F1")))
If Lim <> 0 Then
Pct = Dent / Lim
If newLim <> 0 Then
Increase = Pct * newLim
Differential = Increase - Dent
End If
End If
.Range("e1") = Pct: .Range("g1") = Increase: .Range("H1") = Differential
End With
Next oneRow
End With
Next oneArea
End With
End If
ErrorOut:
Application.EnableEvents = True
End Sub
I an seeking a help to amendment in a VBA Macros. This micros written by one of my friend. But now the problem is below mentioned script is working for columns C,D & F only.
What i need here is Same calculation also work for columns I, J, L,P, Q, S, V,W Y.
Can anyone help me to resolve this issue please.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim keyRange As Range, changedRange As Range
Dim oneArea As Range, oneRow As Range
Dim Dent As Double, Lim As Double, newLim As Double
Dim Pct As Variant, Increase As Variant, Differential As Variant
Set keyRange = Range("C:C,D:D,F:F")
Set changedRange = Application.Intersect(keyRange.EntireColumn, Target)
If Not changedRange Is Nothing Then
On Error GoTo ErrorOut
Application.EnableEvents = False
With changedRange
For Each oneArea In .Areas
With oneArea
For Each oneRow In oneArea.Rows
With oneRow.EntireRow
Dent = Val(CStr(.Range("c1")))
Lim = Val(CStr(.Range("d1")))
newLim = Val(CStr(.Range("F1")))
If Lim <> 0 Then
Pct = Dent / Lim
If newLim <> 0 Then
Increase = Pct * newLim
Differential = Increase - Dent
End If
End If
.Range("e1") = Pct: .Range("g1") = Increase: .Range("H1") = Differential
End With
Next oneRow
End With
Next oneArea
End With
End If
ErrorOut:
Application.EnableEvents = True
End Sub