conditional statement to find more than one value ??

[Guest]

I'm trying to find a value in a row based on the cell color

If colorIndex = 8 Then 'row loop
check the row and find the first cell with colorIndex = 8
If color = 8 is find then 'column loop
'copy cell value destination new cell
Keep going thru the row and find all cell with that color and copy
values
End if 'column loop

Else 'row loop
go to next row
End if 'row loop

The objective is to go through Column A and find the colored cells. Then
find on that cell row checking by columns if there are one or more colored
cells and copy the values to a new list.

Will a loop inside a loop do it?

As usual, any help will be appreciated. Specially today, I seem to be having
a brainless day...

 

[Dave Peterson]

Maybe something like...

Option Explicit
Sub testme()

Dim myCell As Range
Dim newWks As Worksheet
Dim curWks As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Dim iCol As Long
Dim oRow As Long
Dim myColorIndex As Long

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

myColorIndex = 8
oRow = 0
With curWks
With .UsedRange
LastCol = .Columns(.Columns.Count).Column
LastRow = .Rows(.Rows.Count).Row
End With

For iRow = 1 To LastRow
If .Cells(iRow, "A").Font.ColorIndex = myColorIndex Then
For iCol = 1 To LastCol '2 to lastcol????
If .Cells(iRow, iCol).Font.ColorIndex = myColorIndex Then
oRow = oRow + 1
newWks.Cells(oRow, "A").Value _
= .Cells(iRow, iCol).Value
End If
Next iCol
End If
Next iRow
End With
End Sub

 

[Guest]

Thanks Dave. Exactly what I needed it.

Maybe something like...

Option Explicit
Sub testme()

Dim myCell As Range
Dim newWks As Worksheet
Dim curWks As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Dim iCol As Long
Dim oRow As Long
Dim myColorIndex As Long

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

myColorIndex = 8
oRow = 0
With curWks
With .UsedRange
LastCol = .Columns(.Columns.Count).Column
LastRow = .Rows(.Rows.Count).Row
End With

For iRow = 1 To LastRow
If .Cells(iRow, "A").Font.ColorIndex = myColorIndex Then
For iCol = 1 To LastCol '2 to lastcol????
If .Cells(iRow, iCol).Font.ColorIndex = myColorIndex Then
oRow = oRow + 1
newWks.Cells(oRow, "A").Value _
= .Cells(iRow, iCol).Value
End If
Next iCol
End If
Next iRow
End With
End Sub