Hi there,
I have this piece of code working, but I'm having trouble grouping the
results by certain value. The idea is to go through Column A and find the
cells with interior color = 8. If true, go thu Column E to last column and
find all the cells with the same color (good results) and copy them to the
destination column/row. That part is working. When I'm trying to group them
by "SrcFnd5" is when my problem starts. I've tried many things and nothing is
working...

-If destination cell is empty start a new group
-if SrcFnd5 is already there use next empty row
- if destination cell < SrcFnd5 start a new group (combined with first?)

Any help would be greatly appreciated. I'm going in circles and my logic is
long gone...


Sub Select_Results()

Dim te As Long 'total elements
Dim LastEl As Long 'Last Element Row
Dim lastC As String 'Last column letter
Dim i As Long
Dim oRng As Range
Dim DestCol As Long 'Destination column
Dim DestRow As Long 'Destination row
Dim oCol As Long 'zero column
Dim MethRange As Range, SrcChk1 As Range
Dim SrcFnd1 As String, SrcFnd2 As String, SrcFnd3 As String, SrcFnd4 As
String, SrcFnd5 As String, SrcFnd6 As String, DestChk1 As String

Set MethRange = Sheets("Method Ids").Range("A3:A61")

myfilename = Range("H3").Value

Sheets("Results " & myfilename & " data").Select

te = Range("F6").Value
LastEl = (te + 15)
lastC = Range("I100").Value

DestCol = Columns("E").Column
oCol = Columns("E").Column
DestRow = LastEl + 4
oRow = LastEl + 4

With Worksheets("Results " & myfilename & " data").Range("B16").Select
For i = 1 To LastEl
If ActiveCell.Offset(0, -1).Interior.ColorIndex = 8 Then
Cells(DestRow, DestCol).Value = ActiveCell.Offset(0, -1).Value

For Each c In Range(ActiveCell.Offset(0, 3), Cells(i + 15,
lastC))
If c.Interior.ColorIndex = 8 Then

DestChk1 = ActiveCell.Offset(0, -1).Value
Set SrcChk1 = MethRange.Find(What:=DestChk1,
LookAt:=xlWhole, _
SearchOrder:=xlByColumns)

If Not SrcChk1 Is Nothing Then
SrcFnd1 = SrcChk1.Offset(0, 5).Value 'reporting
unit
SrcFnd3 = SrcChk1.Offset(0, 21).Value 'method used
SrcFnd4 = SrcChk1.Offset(0, 22).Value 'date
End If

SrcFnd2 = Cells(c.Row(), 4).Value / 1000 ' detection
limit
SrcFnd5 = Cells(15, c.Column()).Value
SrcFnd6 = Cells(11, c.Column()).Value

Cells(DestRow, DestCol).Value = ActiveCell.Offset(0,
-1).Value
If Cells(DestRow - 1, DestCol + 1).Value = "" Then
DestRow = oRow
Cells(DestRow - 1, DestCol + 1).Value =
SrcFnd5
Cells(DestRow - 1, DestCol + 1).Font.Size = 11
Cells(DestRow - 1, DestCol +
1).HorizontalAlignment = xlCenter
End If

With Cells(DestRow, DestCol + 1)
.Formula = "=" & c.Address(external:=True)
.NumberFormat = c.NumberFormat
.Interior.ColorIndex = 8
.Font.Size = 11
.HorizontalAlignment = xlRight

End With
Cells(DestRow, DestCol + 2).Value = SrcFnd1
Cells(DestRow, DestCol + 3).Value = SrcFnd6
Cells(DestRow, DestCol + 4).Value = SrcFnd2
Cells(DestRow, DestCol + 5).Value = SrcFnd3
Cells(DestRow, DestCol + 5).Font.Size = 11
Cells(DestRow, DestCol + 5).HorizontalAlignment
= xlCenter
Cells(DestRow, DestCol + 5).ColumnWidth = 14.44
Cells(DestRow, DestCol + 6).Value = SrcFnd4
Cells(DestRow, DestCol + 6).HorizontalAlignment
= xlCenter
Cells(DestRow, DestCol + 6).NumberFormat =
"mm/dd/yyyy"
DestCol = DestCol + 8
End If

Next
DestRow = DestRow + 1

End If

DestCol = oCol
ActiveCell.Offset(1, 0).Select
Next i

End With
'Range("H2").Select
End Sub
--
gaba :)