Agnarr
New Member
- Joined
- Jan 15, 2023
- Messages
- 29
- Office Version
- 365
- Platform
- Windows
Hello everyone!
I have a code that does a variety of things and was wondering if any of you, would be kind enough to check it out and tell me if I could make it more simple please.
If you have any questions as to clarify some of the functions it performs, please ask. I will do my best to clarify.
I have a code that does a variety of things and was wondering if any of you, would be kind enough to check it out and tell me if I could make it more simple please.
If you have any questions as to clarify some of the functions it performs, please ask. I will do my best to clarify.
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
' Check if column G is changed
If Not Intersect(Target, Sh.Range("G:G")) Is Nothing Then
Application.ScreenUpdating = False
If Target.Value = "" Then
' Clear cells B, C, D, E, and F
Target.Offset(0, -5).Resize(1, 5).ClearContents
Else
Dim fnd As Range
Set fnd = Sheets("codes").Range("A:A").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
' Copying name and original price
Target.Offset(0, -5).Value = fnd.Offset(0, 1).Value
Target.Offset(0, -3).Value = fnd.Offset(0, 2).Value
' Calculating the price based on quantity
Dim quantity As Double
If IsEmpty(Target.Offset(0, -2).Value) Then
quantity = 1
Else
quantity = Target.Offset(0, -2).Value
End If
Target.Offset(0, -4).Value = Target.Offset(0, -3).Value * quantity
End If
End If
Application.ScreenUpdating = True
End If
' Check if column E is changed
If Not Intersect(Target, Sh.Range("E:E")) Is Nothing Then
Application.ScreenUpdating = False
Dim rng As Range
For Each rng In Target
' Get the corresponding row in column C
Dim cCell As Range
Set cCell = Sh.Cells(rng.Row, "C")
' Recalculate the value in column C based on the formula in your sheet
cCell.Formula = "=IF(E" & rng.Row & "="""",D" & rng.Row & ",D" & rng.Row & "*E" & rng.Row & ")"
Next rng
Application.ScreenUpdating = True
End If
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim ws As Worksheet
Set ws = Sh
Call Workbook_SheetChange(ws, ws.Cells(1, 1)) ' Trigger the code for the new sheet
End Sub