Remove fill in second column based on condition in prior column

[Eric Carolus]

Hi folks

I have two adjacent columns Tickets and Amount.
If the cell in column Tickects (has a ticket number) has a number, then the corresponding cell in Amount has a RED background fill. [my code for this works]
If the cell in column Tickects (has a ticket number) has a number, then the corresponding cell in Amount shows the number 80 (price of ticket) and has a GREEN background fill. [my code for this works]

My problem is as follows: If I remove/clear the ticket number from the Ticket column, the the corresponding cell in the Amount column (a) the fill must become no fill (if the cell fill was RED
(b). The fill must become no fill (if the cell fill was GREEN and the 80 must be removed/cleared from the cell.

Please look at the code on module 1

Any help will be appreciated

Crow

Chicken Braai _Saal_Kommitee_Nov.xlsm
	E
24
Horn Fam

 

[maabadi]

you should upload VBA code separately. We cannot see when you upload sample file with XL2BB Add-in.

 

[Eric Carolus]

Hi folks I will post my code below:

Sub LastRow()

Dim lr As Integer

Dim sh As Worksheet

Dim cella As Range
Dim cellb As Range

Dim Tickets As Range
Dim Amount As Range

Application.ScreenUpdating = False

Set sh = Worksheets("Horn Fam")

'The number of cells with value > 0 is lr
lr = sh.Range("C" & Rows.Count).End(xlUp).Row

' Set the range called Tickets in terms of lr
Set Tickets = sh.Range("C5:C" & lr)
Set Amount = sh.Range("D5:D" & lr)

For Each cella In Tickets
For Each cellb In Amount


If cella.Value > 0 And cellb.Value = 80 Then ''WORKS AS IT SHOULD
cellb.Interior.Color = vbGreen

ElseIf cella.Value > 0 And cellb.Value = 0 Or cellb.Value = "" Then ''WORKS AS IT SHOULD
cellb.Interior.Color = vbRed

' PROBLEM LIES HERE!!
'If the Ticket column is empty and the corresponding cell in the Amount column's cell interior color is RED or GREEN, then the
'(i). Amount column's background must turn to white or no fill and
'(ii). If there the number 80 in the Amount column, then the Amount column's background must turn to white or no fill AND
' the number 80 must be removed (cleared from the cell)

'THIS DOES NOT WORK!!!!!! HELP REQUIRED HERE!!
ElseIf cella.Value = 0 And cellb.Interior.Color = vbRed Then
cella.Interior.Color = xlNone


End If
Next cellb
Next cella
Application.ScreenUpdating = True
End Sub

Eric

 

[maabadi]

You has problem at red part:

Sub LastRow()
Dim lr As Integer, sh As Worksheet, cella As Range, cellb As Range
Dim Tickets As Range, Amount As Range

Application.ScreenUpdating = False
Set sh = Worksheets("Horn Fam")
'The number of cells with value > 0 is lr
lr = sh.Range("C" & Rows.Count).End(xlUp).Row
' Set the range called Tickets in terms of lr
Set Tickets = sh.Range("C5:C" & lr)
Set Amount = sh.Range("D5:D" & lr)
For Each cella In Tickets
For Each cellb In Amount


If cella.Value > 0 And cellb.Value = 80 Then ''WORKS AS IT SHOULD
cellb.Interior.Color = vbGreen

ElseIf cella.Value > 0 And cellb.Value = 0 Or cellb.Value = "" Then ''WORKS AS IT SHOULD
cellb.Interior.Color = vbRed

' PROBLEM LIES HERE!!
'If the Ticket column is empty and the corresponding cell in the Amount column's cell interior color is RED or GREEN, then the
'(i). Amount column's background must turn to white or no fill and
'(ii). If there the number 80 in the Amount column, then the Amount column's background must turn to white or no fill AND
' the number 80 must be removed (cleared from the cell)

'THIS DOES NOT WORK!!!!!! HELP REQUIRED HERE!!
ElseIf cella.Value = 0 And cellb.Interior.Color = vbRed Then
cella.Interior.Color = xlNone
End If
Next cellb
Next cella
Application.ScreenUpdating = True
End Sub

Change (Cella to Cellb for xlNone) Red Part to :

ElseIf cella.Value = 0 And cellb.Interior.Color = vbRed Then
cellb.Interior.Color = xlNone

or if Empty Cella then should be:

ElseIf cella.Value = "" And cellb.Interior.Color = vbRed Then
cellb.Interior.Color = xlNone

 

[Eric Carolus]

Hi maabadi

It still does not work after having made the changes that you suggested.

Any other suggestions?

Eric

 

[maabadi]

Try this:

Sub LastRow()
Dim lr As Integer, sh As Worksheet, i As Long
', cella As Range, cellb As Range, Tickets As Range, Amount As Range

Application.ScreenUpdating = False
Set sh = Worksheets("Horn Fam")
'The number of cells with value > 0 is lr
lr = sh.Range("D" & Rows.Count).End(xlUp).Row
' Set the range called Tickets in terms of lr
For i = 5 To lr
If Range("C" & i).Value > 0 And Range("D" & i).Value = 80 Then ''WORKS AS IT SHOULD
Range("D" & i).Interior.Color = vbGreen

ElseIf Range("C" & i).Value > 0 And Range("D" & i).Value = 0 Or Range("D" & i).Value = "" Then ''WORKS AS IT SHOULD
Range("D" & i).Interior.Color = vbRed

ElseIf Range("C" & i).Value = 0 And Range("D" & i).Interior.Color <> xlNone Then
Range("D" & i).Interior.Color = xlNone
End If
Next i
Application.ScreenUpdating = True
End Sub

This one also change color of Green cells if data at column C equal 0 or ""
if you want only Change red cells Color Change xlNone at this Line to VbRed