| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
It works but I need better code...
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 |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Code somewhat works. Please help? | Excel Programming | |||
| Why this code works and other do not? Newbie here. | Excel Programming | |||
| Code works for any WBK except the PMW | Excel Programming | |||
| Why won't this code works | Excel Programming | |||
| VBA Code Works in 97, Not in 2002 | Excel Programming | |||
Threaded Mode
