CODEWITHSUNDEEP
excelvba
Sat
Sat

Reputation: 23

VBA - Set range by matching column and row values

I am quite new to VBA and after lots of searching I haven't been able to find any help to the following problem.

I have a fairly large and complex table containing a lot of data. The data within the table has been conditional formatted to have different color fills. Using the following code, I am able to count the number of cells of a certain color within each range.

However I am looking to replace the range with for example something along the lines of; IF column C value matches "Apples" AND IF row 3 value matches "Farm A" THEN count green fills within this area.

The code I am using so far is below.

Dim rng As Range
Dim lColorCounter As Long
Dim rngCell As Range

Sheets("Matrix").Select
Set rng = Sheet1.Range("F140:O150")
For Each rngCell In rng
   If Cells(rngCell.Row, rngCell.Column).DisplayFormat.Interior.Color = RGB(185, 255, 185) Then
        lColorCounter = lColorCounter + 1
    End If
Next
  Sheets("Summary").Activate
    Sheet3.Range("C4") = lColorCounter
     lColorCounter = 0

Hope this makes sense and any help will really be appreciated. Thank you!

Upvotes: 2

Views: 1063

Answers (1)

urdearboy
urdearboy

Reputation: 14580

As discussed in comments, this has a dynamic row loop (check for value of Apples) and a dynamic column loop (check for color of cells).

The range of the 2nd loop is determined by the size of your merged cell ("Farm A") which starts in cell C2. So if you change your Farm A merged cell to span 20 columns, the loop will expand to those 20 columns. 

Option Explicit

Sub test()

Dim i As Long, FarmA As Integer, MyCell As Range, lColorCounter As Long
Dim Matrix As Worksheet: Set Matrix = ThisWorkbook.Sheets("Matrix")

Application.ScreenUpdating = False
    With Matrix
    FarmA = .Range("C2").CurrentRegion.Count + 2 'Determine size of merged cell "FarmA"
        For i = 3 To .Range("B" & .Rows.Count).End(xlUp).Row 'Loop through used rows in Col B
            If .Range("B" & i) = "Apples" Then 'If condition is met, move to next line, else, check next row
                For Each MyCell In .Range(.Cells(i, 3), .Cells(i, FarmA)) 'set serach range
                    If MyCell.DisplayFormat.Interior.Color = RGB(185, 255, 185) Then 'search for format
                        lColorCounter = lColorCounter + 1
                    End If
                Next MyCell
            End If
        Next i
    End With
Application.ScreenUpdating = True

MsgBox lColorCounter

End Sub

Upvotes: 1

Related Questions