PDA

View Full Version : [SOLVED:] problem adding 2 values ​​in 2 columns



RuneDefour
04-03-2023, 05:21 AM
everything runs smoothly except at step. adding 2 the value in column 5 and the value in column 7. the result is not correct and the whole program crashes and exits. what's my mistake? the bold is where it goes wrong


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long
Dim i As Long
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 11 To lastRow
If Cells(i, 8) = 0 Then
If Cells(i, 7) < 1 And Cells(i, 5) < Cells(i, 6) Then
Cells(i, 5).Interior.Color = RGB(255, 153, 153)
ElseIf Cells(i, 5) >= Cells(i, 6) Then
Cells(i, 5).Interior.Color = RGB(255, 255, 255)
ElseIf Cells(i, 7) >= 1 Then
Cells(i, 5).Interior.Color = RGB(255, 204, 153)
End If
ElseIf Cells(i, 8) >= 1 Then
Cells(i, 5).Value = Cells(i, 5).Value + Cells(i, 7).Value
Cells(i, 7).Value = 0
Cells(i, 5).Interior.ColorIndex = xlColorIndexNone
End If
Next i
End Sub

arnelgp
04-03-2023, 06:04 AM
can you just Create a Conditional Formatting on the Cells, instead of using VBA code.


Private Sub Worksheet_Change(ByVal Target As Range)Dim lastRow As Long
Dim i As Long
Application.EnableEvents = False
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 11 To lastRow
If Val(Cells(i, 8) & "") = 0 Then
If Val(Cells(i, 7) & "") < 1 And Val(Cells(i, 5) & "") < Val(Cells(i, 6) & "") Then
Cells(i, 5).Interior.Color = RGB(255, 153, 153)
ElseIf Val(Cells(i, 5) & "") >= Val(Cells(i, 6) & "") Then
Cells(i, 5).Interior.Color = RGB(255, 255, 255)
ElseIf Val(Cells(i, 7) & "") >= 1 Then
Cells(i, 5).Interior.Color = RGB(255, 204, 153)
End If
ElseIf Val(Cells(i, 8) & "") >= 1 Then
Cells(i, 5) = Val(Cells(i, 5) & "") + Val(Cells(i, 7) & "")
Cells(i, 7) = 0
Cells(i, 5).Interior.ColorIndex = xlColorIndexNone
End If
Next i
Application.EnableEvents = True
End Sub

Paul_Hossler
04-04-2023, 07:13 AM
Couple of observations

You don't use Target so every change triggers the event handler

You don't turn off EnableEvents inside so it keeps calling itself until Excel gives up




Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long
Dim i As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Application.EnableEvents = False
For i = 11 To lastRow
If Cells(i, 8) = 0 Then
If Cells(i, 7) < 1 And Cells(i, 5) < Cells(i, 6) Then
Cells(i, 5).Interior.Color = RGB(255, 153, 153)
ElseIf Cells(i, 5) >= Cells(i, 6) Then
Cells(i, 5).Interior.Color = RGB(255, 255, 255)
ElseIf Cells(i, 7) >= 1 Then
Cells(i, 5).Interior.Color = RGB(255, 204, 153)
End If
ElseIf Cells(i, 8) >= 1 Then
Cells(i, 5).Value = Cells(i, 5).Value + Cells(i, 7).Value
Cells(i, 7).Value = 0
Cells(i, 5).Interior.ColorIndex = xlColorIndexNone
End If
Next i
Application.EnableEvents = True
End Sub