It works but I need better code...

F

fzl2007

The following code works fine. I believe I can use a do loop to make
the code more efficient. Can someone help? I appreciate it.

Private Sub Worksheet_Change(ByVal Target As Range)
getReportingCode

On Error GoTo ErrorHandler

ActiveSheet.Unprotect
Dim mnb As Integer

Dim asd, asd2, colb, cole, colf, colg, colh, coli2l, cole2l As
Integer
Application.EnableEvents = False


If Not Intersect(Target, Range("B7:L35")) Is Nothing Then

colb = Application.CountA(Worksheets("Employee").Range("b" &
Target.Row))
cole = Application.CountA(Worksheets("Employee").Range("e" &
Target.Row))
colf = Application.CountA(Worksheets("Employee").Range("f" &
Target.Row))
colg = Application.CountA(Worksheets("Employee").Range("g" &
Target.Row))
colh = Application.CountA(Worksheets("Employee").Range("h" &
Target.Row))
coli2l = Application.CountA(Worksheets("Employee").Range("i" &
Target.Row & ":" & "l" & Target.Row))
cole2l = Application.CountA(Worksheets("Employee").Range("i" &
Target.Row & ":" & "l" & Target.Row))


If (colb > 0) Then
If (cole = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If
End If

If (cole > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If
End If

If (colf > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (cole = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If
End If

If (colg > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (cole = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If
End If

If (colh > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If
End If

If (coli2l > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (cole = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If


End If



End If


Application.EnableEvents = True
Application.ScreenUpdating = True

ActiveSheet.Protect

Exit Sub
ErrorHandler:
Application.EnableEvents = True
' MsgBox Err.Number & " " & Err.Description
Resume Next
End Sub


Thanks.

Faye
 
G

Guest

Is this better????



Private Sub Worksheet_Change(ByVal Target As Range)
getReportingCode

On Error GoTo ErrorHandler

ActiveSheet.Unprotect
Dim mnb As Integer

Application.EnableEvents = False


If Not Intersect(Target, Range("B7:L35")) Is Nothing Then


If Target.Column = 2 Or _
(Target.Column >= 6 And Target.Column <= 7) Then

If Target.Value = 0 Then

Worksheets("Employee").Range("e" & Target.Row). _
Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" & Target.Row). _
Interior.ColorIndex = xlNone

End
End If

End If

Application.EnableEvents = True
Application.ScreenUpdating = True

ActiveSheet.Protect

Exit Sub
ErrorHandler:
Application.EnableEvents = True
' MsgBox Err.Number & " " & Err.Description
Resume Next
End Sub
 
F

fzl2007

I tested it and couldn't make it work with your code. It does not turn
any field into yellow.
 
G

Guest

Can you put a break point in the code and tell me why it is not working?

Add break point by pressing F9 on first line
Private Sub Worksheet_Change(ByVal Target As Range)


Highlight one cell in workbook and the in the Fx box at top of worksheet
hight box and press enter. This will force the workbook to recognize the
change and go to break point.

moving tthe mouse over the variable will show there values or you can add
the variabble into the watch window by press right mouse on the items you
want to watch.


then step through code by press F8.
 
G

Guest

Noticed a small problem why it may not work try this

Private Sub Worksheet_Change(ByVal Target As Range)
getReportingCode

On Error GoTo ErrorHandler

ActiveSheet.Unprotect
Dim mnb As Integer

Application.EnableEvents = False


If Not Intersect(Target, Range("B7:L35")) Is Nothing Then


If Target.Column = 2 Or _
(Target.Column >= 6 And Target.Column <= 7) Then

If Target.Value = 0 Then

Worksheets("Employee").Target. _
Interior.ColorIndex = 36
Else
Worksheets("Employee").Target. _
Interior.ColorIndex = xlNone

End
End If

End If

Application.EnableEvents = True
Application.ScreenUpdating = True

ActiveSheet.Protect

Exit Sub
ErrorHandler:
Application.EnableEvents = True
' MsgBox Err.Number & " " & Err.Description
Resume Next
End Sub
 
G

Guest

Faye,

Give this a try.


Private Sub Worksheet_Change(ByVal Target As Range)
getReportingCode

On Error GoTo ErrorHandler

ActiveSheet.Unprotect
Dim mnb As Integer

Application.EnableEvents = False

Dim rng As Range
Dim c As Range

If Not Intersect(Target, Range("B7:L35")) Is Nothing Then
With Worksheets("Employee")
Set rng = .Range("B" & Target.Row & ",E" & Target.Row & ":H" &
Target.Row & ",I" & Target.Row & ":L" & Target.Row)
If Application.CountA(rng) > 0 Then
For Each c In rng
If c.Column < 9 And c.Value = 0 Then
c.Interior.ColorIndex = 36
Else
c.Interior.ColorIndex = xlNone
End If
Next c
End If
End With
End If


Application.EnableEvents = True
Application.ScreenUpdating = True

ActiveSheet.Protect

Exit Sub
ErrorHandler:
Application.EnableEvents = True
' MsgBox Err.Number & " " & Err.Description
Resume Next
End Sub
 
F

fzl2007

It works great. I will need to look at your code to see where I need
to update so that it will unhighlight when you delete the number
(null). It wasn't included in my original code. I changed my code like
the following in order to accomplish it:

Private Sub Worksheet_Change(ByVal Target As Range)
getReportingCode

On Error GoTo ErrorHandler

ActiveSheet.Unprotect
Dim mnb As Integer

Dim asd, asd2, colb, cole, colf, colg, colh, coli2l, cole2l As
Integer
Application.EnableEvents = False


If Not Intersect(Target, Range("B7:L35")) Is Nothing Then

colb = Application.CountA(Worksheets("Employee").Range("b" &
Target.Row))
cole = Application.CountA(Worksheets("Employee").Range("e" &
Target.Row))
colf = Application.CountA(Worksheets("Employee").Range("f" &
Target.Row))
colg = Application.CountA(Worksheets("Employee").Range("g" &
Target.Row))
colh = Application.CountA(Worksheets("Employee").Range("h" &
Target.Row))
coli2l = Application.CountA(Worksheets("Employee").Range("i" &
Target.Row & ":" & "l" & Target.Row))
cole2l = Application.CountA(Worksheets("Employee").Range("i" &
Target.Row & ":" & "l" & Target.Row))


If (colb > 0) Then
If (cole = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If

Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
Worksheets("Employee").Range("i" &
Target.Row).Interior.ColorIndex = xlNone
Worksheets("Employee").Range("j" &
Target.Row).Interior.ColorIndex = xlNone
Worksheets("Employee").Range("k" &
Target.Row).Interior.ColorIndex = xlNone
Worksheets("Employee").Range("l" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (cole > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If
End If

If (colf > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (cole = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If
End If

If (colg > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (cole = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If
End If

If (colh > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (cole = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If
End If

If (coli2l > 0) Then
If (colb = 0) Then
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("b" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (cole = 0) Then
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("e" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colf = 0) Then
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("f" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colg = 0) Then
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("g" &
Target.Row).Interior.ColorIndex = xlNone
End If

If (colh = 0) Then
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = 36
Else
Worksheets("Employee").Range("h" &
Target.Row).Interior.ColorIndex = xlNone
End If

End If


End If


Application.EnableEvents = True
Application.ScreenUpdating = True

ActiveSheet.Protect

Exit Sub
ErrorHandler:
Application.EnableEvents = True
' MsgBox Err.Number & " " & Err.Description
Resume Next
End Sub


Thank you so very much for your time.
 
G

Guest

From what I can tell with the code you added, you don't want the cells to
highlight if the cell in Column B is blank. If so, try it this way.


Private Sub Worksheet_Change(ByVal Target As Range)
getReportingCode

On Error GoTo ErrorHandler

ActiveSheet.Unprotect
Dim mnb As Integer

Application.EnableEvents = False

Dim rng As Range
Dim c As Range

If Not Intersect(Target, Range("B7:L35")) Is Nothing Then
With Worksheets("Employee")
Set rng = .Range("B" & Target.Row & ",E" & Target.Row & ":H" &
Target.Row & ",I" & Target.Row & ":L" & Target.Row)
If Application.CountA(rng) > 0 Then
For Each c In rng
If c.Column < 9 And c.Text = "" Then
c.Interior.ColorIndex = IIf(.Range("B" &
Target.Row).Text = "", xlNone, 36)
Else
c.Interior.ColorIndex = xlNone
End If
Next c
End If
End With
End If


Application.EnableEvents = True
Application.ScreenUpdating = True

ActiveSheet.Protect

Exit Sub
ErrorHandler:
Application.EnableEvents = True
' MsgBox Err.Number & " " & Err.Description
Resume Next
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Copy a Cell with a macro 2
can you make this faster? 2
Active Cell 4
removing hard coding from code 5
Interior color disappears 1
worksheet_change colour of a row on change of cell 15
FormatConditions appears to kill copypaste 2
Worksheet events and a little bit extra code 3

Top