Home |
Search |
Today's Posts |
#5
![]() |
|||
|
|||
![]()
This is what I came up with. This is not the most effective code but
this is all I could come up with. Can anyone help rearrange/consolidate this code to where it would be more effective? Thanks for any help... Sub CondFormatOwner2() ' Highlight property that is owned by businesses (LLC, INC, etc.) Dim r As Range Dim CFmaxRow As String MaxRow CFmaxRow = "E" & oRowMax Set r = Range(Range("E2"), Range(CFmaxRow).End(xlUp)) Dim strTemp As String Dim cnt As Integer 'Check for properties owned by CO, etc. (3 char) cnt = 1 Do While cnt <= oRowMax strTemp = Right(r.Cells(cnt).Value, 4) Select Case strTemp Case " C0" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 5 Case " Co" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 5 Case Else r.Cells.Interior.ColorIndex = xlColorIndexNone r.Cells.Font.Bold = False End Select cnt = cnt + 1 Loop 'Check for properties owned by LLC, INC, Inc, etc. (4 char) cnt = 1 Do While cnt <= oRowMax strTemp = Right(r.Cells(cnt).Value, 4) Select Case strTemp Case " LLC" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 5 Case " INC" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 5 Case " Inc" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 5 Case "Help" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 3 Case Else r.Cells.Interior.ColorIndex = xlColorIndexNone r.Cells.Font.Bold = False End Select cnt = cnt + 1 Loop 'Check for properties owned by PROP, COMP, Comp, etc. (5 char) cnt = 1 Do While cnt <= oRowMax strTemp = Right(r.Cells(cnt).Value, 5) Select Case strTemp Case " PROP" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 5 Case " Comp" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 5 Case " COMP" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 5 Case Else r.Cells.Interior.ColorIndex = xlColorIndexNone r.Cells.Font.Bold = False End Select cnt = cnt + 1 Loop 'Check for properties owned by L L C, etc. (6 char) cnt = 1 Do While cnt <= oRowMax strTemp = Right(r.Cells(cnt).Value, 6) Select Case strTemp Case " L L C" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 5 Case Else r.Cells.Interior.ColorIndex = xlColorIndexNone r.Cells.Font.Bold = False End Select cnt = cnt + 1 Loop 'Check for properties owned by "**Error**", etc. (9 char) cnt = 1 Do While cnt <= oRowMax strTemp = Right(r.Cells(cnt).Value, 9) Select Case strTemp Case "**Error**" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 3 Case Else r.Cells.Interior.ColorIndex = xlColorIndexNone r.Cells.Font.Bold = False End Select cnt = cnt + 1 Loop 'Check for properties owned by PROPERTIES, etc. (11 char) cnt = 1 Do While cnt <= oRowMax strTemp = Right(r.Cells(cnt).Value, 11) Select Case strTemp Case " PROPERTIES" r.Cells(cnt).Interior.ColorIndex = 19 r.Cells(cnt).Font.Bold = True r.Cells(cnt).Font.ColorIndex = 3 Case Else r.Cells.Interior.ColorIndex = xlColorIndexNone r.Cells.Font.Bold = False End Select cnt = cnt + 1 Loop End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Excel 2003 FAILS, but Excel 2000 SUCCEEDS ??? | Excel Discussion (Misc queries) | |||
Copy conditional formatting across multiple rows? | Excel Discussion (Misc queries) | |||
Determine cells that drive conditional formatting? | Excel Discussion (Misc queries) | |||
Conditional formatting not available in Excel | Excel Discussion (Misc queries) | |||
Adding more than three Conditions to 'Conditional Formatting' | Excel Discussion (Misc queries) |