Need help condensing VBA

[IBAUCLAPlaya]

I wrote the following macro to basically allow for conditional formatting in Excel 2003 with 10 conditions. Basically the formula is doing the same thing over and over again 845 times (65 rows x 13 colums).
I have this saved in the worksheet so that it automatically updates every time I change something but the code is WAYYY too long and errors out.
Is there any way to condense this so it still works?

<!- Extremely long content removed -->

 

[circledchicken]

Ok, I'm not sure why - maybe post your workbook e.g. on SkyDrive or Box.com and I can try and have a look.

 

[IBAUCLAPlaya]

sending PM now...

 

[Zack Barresse]

Try with these alterations...

Private Const sRangeToCheck = "L467:X531"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iColor As Long, iRow As Long, sCol As String, iLoop As Long, sTemp() As String
    If Intersect(Target, Me.Range(sRangeToCheck)) Is Nothing Then Exit Sub
    iRow = Target.Row - 467
    Select Case Target.Value
        Case "FC":      iColor = 3
        Case "BC":      iColor = 45
        Case "ADFEAT":  iColor = 4
        Case "AD":      iColor = 6
        Case "LL":      iColor = 40
        Case "ROP":     iColor = 41
        Case "AMD":     iColor = 26
        Case "MB":      iColor = 31
        Case "AAM":     iColor = 8
        Case Is > 0:    iColor = 22
    End Select
    sCol = Split(Target.Address(), "$")(1)
    If Me.Cells(iRow + 71, sCol).Value > 0 Then iColor = 22
    Me.Range(sCol & iRow + 5 & "," & sCol & iRow + 71 & "," & sCol & iRow + 137 & "," & _
             sCol & iRow + 203 & "," & sCol & iRow + 269 & "," & sCol & iRow + 335 & "," & _
             sCol & iRow + 401 & "," & sCol & iRow + 467 & "," & sCol & iRow + 533 & "," & _
             sCol & iRow + 599 & "," & sCol & iRow + 669 & "," & sCol & iRow + 741 & "," & _
             sCol & iRow + 812 & "," & sCol & iRow + 883 & "," & sCol & iRow + 954 & "," & _
             sCol & iRow + 1025 & "," & sCol & iRow + 1096 & "," & sCol & iRow + 1167 & "," & _
             sCol & iRow + 1233 & "," & sCol & iRow + 1299 & "," & sCol & iRow + 1365 & "," & _
             sCol & iRow + 1436 & "," & sCol & iRow + 1507 & "," & sCol & iRow + 1573 & "," & _
             sCol & iRow + 1644 & "," & sCol & iRow + 1715 & "," & sCol & iRow + 1786 & "," & _
             sCol & iRow + 1857 & "," & sCol & iRow + 1928).Interior.ColorIndex = iColor
    iRow = Target.Row - 455
    Sheets("QUICKView").Range(sCol & iRow & ":" & sCol & iRow + 17).Offset(0, -9).Interior.ColorIndex = iColor
End Sub

 

[IBAUCLAPlaya]

No luck...sending you a PM.

 

[Zack Barresse]

The code seems to work for me.... What exactly isn't working?

 

[circledchicken]

I changed mine a little - including the sheet names:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long, j As Long, k As Long
Dim IC As Long

For i = 1 To 13 ' 13 columns
    For j = 1 To 65 ' 65 rows
        IC = 0 'if none of the conditions below are met 0 is the default colour
        Select Case Sheets("MASTER").Cells(466 + j, 11 + i).Value
            Case "FC"
                IC = 3
            Case "BC"
                IC = 45
            Case "ADFEAT"
                IC = 4
            Case "AD"
                IC = 6
            Case "LL"
                IC = 40
            Case "ROP"
                IC = 41
            Case "AMD"
                IC = 26
            Case "MB"
                IC = 31
            Case "AAM"
                IC = 8
            Case Else
                If Sheets("MASTER").Cells(70 + j, 11 + i).Value > 0 Then
                    IC = 22
                End If
        End Select
        For k = 0 To 28
            Sheets("MASTER").Cells(Array(5, 71, 137, 203, 269, 335, 401, 467, 533, 599, 669, 741, 812, 883, 954, 1025, 1096, 1167, 1233, 1299, 1365, 1436, 1507, 1573, 1644, 1715, 1786, 1857, 1928)(k), 11 + j).Interior.ColorIndex = IC
        Next k
        With Sheets("Quickview")
            .Range(.Cells(12 + ((i - 1) * 18), 2 + j), .Cells(29 + ((i - 1) * 18), 2 + j)).Interior.ColorIndex = IC
        End With
    Next j
Next i

End Sub

 

[Zack Barresse]

I'm not sure I'd go with a double loop solution. While I admire your code, circledchicken, I wouldn't recommend it here. In fact, it brings up another question for the OP - do you want an un-color ability here? If so, I'd be tempted to move it to a standard sub routine in a standard module and call it from there with a couple of change events.

 

[circledchicken]

I'm not sure I'd go with a double loop solution. While I admire your code, circledchicken, I wouldn't recommend it here. In fact, it brings up another question for the OP - do you want an un-color ability here? If so, I'd be tempted to move it to a standard sub routine in a standard module and call it from there with a couple of change events.

I agree with you! Mine is not a good idea - in fact it's triple loop, there's another one setting the colours. Your technique is much better, and to be honest I haven't looked at the spreadsheet properly and I'm still a bit unsure exactly what's required.

 

[Zack Barresse]

I think that's the biggest problem we have right now, everyone is unsure of the exact requirements. We'll see if the OP can fill us in a little more.

 

[IBAUCLAPlaya]

Yes I would like an uncolor function.

There are three subsets I'm looking to check. For simplicity let's refer to them as IR, MARKER and IR CREDIT:
IR - Master Sheet(L467:X531)
MARKER - Master Sheet(L71:X135)
IR CREDIT - Master Sheet(L1299:X1363)

For the code, I would want it to check the following in this order ANY time either the IR, MARKER, or IR CREDIT subset cell is touched:

If MARKER = "FC" Then COLOR = 3
If MARKER = "BC" Then COLOR = 45
If MARKER = "ADFEAT" Then COLOR = 4
If MARKER = "AD" Then COLOR = 6
If MARKER = "LL" Then COLOR = 40
If MARKER = "ROP" Then COLOR = 41
If MARKER = "AMD" Then COLOR = 26
If MARKER = "MB" Then COLOR = 31
If MARKER = "AAM" Then COLOR = 8
If IR.Value > 0 Then COLOR = 22
If None of the Above Then COLOR = 0
End If

If IR CREDIT.Value > 0 Then COLOR_REF2 = 12
If Not Then COLOR_REF2 = COLOR

Now we have two color variables checked, COLOR and COLOR_REF2:
I would like COLOR applied to the following Ranges if the one of the conditions above for the first row, first column cell of the subsets (L71,L467,L1299), holds true:
GROUP A: Master sheet - L5,L71,L137,L203,L269,L334,L401,L467,L533,L599,L669,L740,L812,L883,L954,L1025,L1096,L1167,L1233,L1299,L1365,L1436,L1507,L1573,L1644,L1715,L1786,L1857,L1928 = COLOR
GROUP B: Quickview sheet - C12:C28 = COLOR
GROUP C: Quickview sheet - C29:C29 = COLOR_REF2 & Font.Color = Red and Type = Bold

Moving on to check the second row first column cell of the subsets (L72,L468,L1300), if one of the conditions hold true the following cells should be colored:
GROUP A + 1 row (L6,L72,L138,etc.)= COLOR
GROUP B + (1*18) rows (C30:C46)=COLOR
GROUP C + (1*18) rows (C47:C47)= COLOR_REF2

Moving on to check the third row, first column cell of the subsets (L73,L469,L1301), if one of the conditions hold true the following cells should be colored:
GROUP A + 2 rows (L8,L74,L140,etc.)= COLOR
GROUP B + (2*18) rows (C48:C64)= COLOR
GROUP C + (2*18) rows(C65:C65)= COLOR_REF2

Now moving on to check fourth row, second column cell of the subsets (M74,M470,M1302), if one of hte conditions hold true the following cells should be colored:
GROUP A offset 1 column to the right and + 3 rows (M9,M75,M141,etc.)= COLOR
GROUP B offset 1 column to the right and + (3*18) rows (C66:C82)= COLOR
GROUP C offset 1 column to the right and + (3*18) rows (C83:C83)= COLOR_REF2

and so on. My original code in the original post had all of of this working but it was just too long.

A few other conditions:
Example.
L467 = "AD"
L71 = 20
L1299 = 10
The formatting for this should be color 6 for groups A & B and color 12,bold,red font for group C.
Now if I was to clear cell L1299, Group C color should change to color 6 and groups A & B should stay color 6
Now if I cleared cell L467, Groups A,B,C should all change to color 22
Now if I added the value 10 back to L1299, Groups A,B shoudl stay 22 but Group C should now be color 12 again.
Now if I clear L71 and L1299, Groups A,B,C formats should go back to no fill

Does this help clarify. Sorry for the long windedness.

Here is a link to a sample of the file on box.com. Hopefully this will help clarify...
http://www.box.com/s/finjk49crau4jxhqpe1b