Use VBA to select Excel cell values conditionally based on cell format (cell background color) - excel

Question

i want to print value where background yellow is same as cell and background white is [0,0]
for this condition i want to get
[1,9],[0,0],[1,7],[1,6],[0,0],[1,4],[0,0],[1,2],[0,0]
I've written some code
Dim isect As Range
Set isect = Intersect(Target, Me.Range("$B$80:$J$80"))
If Not isect Is Nothing Then
Dim s As String
If Target.Interior.Color = vbYellow Then
s = Target.Value
Else
s = "[0,0]"
End If
Range("D96").Value = s
but it get only one value, what I should do for continuing.
Any help will be appreciated.

Answer 1

Dim isect As Range
Dim aCell As Range
Dim Output As String
Set isect = Intersect(target, Me.Range("$B$80:$J$80"))
If Not isect Is Nothing Then
For Each aCell In isect
If aCell.Interior.Color = vbYellow Then
Output = Output & "," & aCell.Value
Else
Output = Output & "," & "[0,0]"
End If
Next aCell
Range("D96") = Mid(Output, 2)
End If
Is this what you want?

Answer 2

Dependent on Cell Property (Fill Color)
Standard Module Code (e.g. Module1)
Option Explicit
Function getString(SourceRange As Range, _
Optional ByVal FillColor As Long = 0, _
Optional ByVal CriteriaNotMetValue As Variant = Empty, _
Optional ByVal Delimiter As String = ", ") _
As String
If SourceRange Is Nothing Then Exit Function
' Write values of range to array.
Dim Data As Variant
If SourceRange.Rows.Count > 1 Or SourceRange.Columns.Count > 1 Then
Data = SourceRange.Value
Else
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = SourceRange.Value
End If
' Modify values in array.
Dim i As Long, j As Long, Result As String
For i = 1 To UBound(Data)
For j = 1 To UBound(Data, 2)
If SourceRange.Cells(i, j).Interior.Color <> FillColor Then
Data(i, j) = CriteriaNotMetValue
End If
Result = Result & Delimiter & Data(i, j)
Next j
Next i
' Remove redundant Delimiter.
getString = Right(Result, Len(Result) - Len(Delimiter))
End Function
Sheet Code (e.g. Sheet1)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const rngAddress As String = "B80:J80"
Const cellAddress As String = "D96"
Const CriteriaNotMetValue As Variant = "[0,0]"
Const FillColor As Long = vbYellow
Const Delimiter As String = ","
If Intersect(Me.Range(rngAddress), Target) Is Nothing Then Exit Sub
On Error GoTo clearError
Application.EnableEvents = False
Dim Result As String
Result = getString(Me.Range(rngAddress), FillColor, CriteriaNotMetValue, Delimiter)
Me.Range(cellAddress).Value = Result
CleanExit:
Application.EnableEvents = True
Exit Sub
clearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
On Error GoTo 0
GoTo CleanExit
End Sub