Meet Combination Criteria and dump data accordingly

COMBINATION MATCH TO CRITERIA AND DUMP IN SECTIONED OFF ROWS.

PLEASE SEE ATTACHED SPREAD SHEET AND CODE

I need it to go down each row if C2 matches C1 and O2 matches O1 copy the entire row.....Continue this untill it gathers 6 matched rows. Once it gathers 6 matched rows then dump it in sheet 3.

Sheet3 contains marked off locations for 6 matches to be associated togeather. The kicker is I do not want anything in rows that are spaced apart with blue fill.

I have gotten my code to accomplish the first round...it clears the array but does not skip 1 row (sectioned off by blue fill) and continue to dump. Can anyone help with this PLEASE!!!


Sub STcombo()

On Error Resume Next

Dim row As Integer
Const cols = 16
Dim Combo(50, cols) As Variant
Dim ComboMatch() As Variant
Dim colm As Integer
Dim Batchsize As Integer
Dim count As Integer
lastrow = 50
lastcol = 16
Dim ComboCount As Integer

Sheets("sheet1").Select

Range("a1").Select

For i = 0 To lastrow

Combo(i, 1) = ActiveCell.Offset(i, 0).Value 'Item No.
Combo(i, 2) = ActiveCell.Offset(i, 1).Value 'Item Description
Combo(i, 3) = ActiveCell.Offset(i, 2).Value 'Quantity
Combo(i, 4) = ActiveCell.Offset(i, 3).Value 'Job No.
Combo(i, 5) = ActiveCell.Offset(i, 4).Value 'Die No.
Combo(i, 6) = ActiveCell.Offset(i, 5).Value '# UP
Combo(i, 7) = ActiveCell.Offset(i, 6).Value '# Colors
Combo(i, 8) = ActiveCell.Offset(i, 7).Value 'Color 1
Combo(i, 9) = ActiveCell.Offset(i, 8).Value 'Color 2
Combo(i, 10) = ActiveCell.Offset(i, 9).Value 'Color 3
Combo(i, 11) = ActiveCell.Offset(i, 10).Value 'Color 4
Combo(i, 12) = ActiveCell.Offset(i, 11).Value 'Color 5
Combo(i, 13) = ActiveCell.Offset(i, 12).Value 'Color 6
Combo(i, 14) = ActiveCell.Offset(i, 13).Value 'Color 7
Combo(i, 15) = ActiveCell.Offset(i, 14).Value
Combo(i, 16) = ActiveCell.Offset(i, 15).Value
'Column 15 is used later to mark a row when it is used in a combo
Next i


For i = 1 To lastrow
If Combo(i, 16) = "" Then 'use for match first line
Combo(i, 16) = Combo(i, 3) ' use for match first line
ComboCount = 1

For x = i + 1 To lastrow


If Combo(i, 15) = Combo(x, 15) And Combo(i, 3) = Combo(x, 3) Then ' this works
Combo(x, 16) = Combo(i, 3) 'And ComboCount = ComboCount + 1 'this works

End If
Next x
End If
Next i

ReDim ComboMatch(6, 16) 'Clears initial list

For a = 0 To lastrow
For b = 0 To cols


ComboMatch(a, b) = Combo(a, b)

Next b

'For c = a + 1 To lastrow
If a = 6 Then 'array is full write combo to sheet.

Sheets("sheet3").Range("a2:p7").Value = ComboMatch 'Pastes data from array to spreadsheet.

ReDim ComboMatch(6, 16) 'Clears the list
End If
Next a
'End If

Hi chrismartinpetty

You forgot code tags...and part of your code...please include them... perhaps we can help.