Hi,

Here is the background:

I have a rather large database of thousands of rows starting at colum
BA:BH and the list starts at row : 3

BA contains the account#
BD the Date as Date
BG the CrossAttempt as Boolean
BH the Fruit. as String

I want to create a list starting at DA:DH row 8

This list will contain all the entries that match the date between the
FROMDATE (DB:4) and TODATE (DD4)

One Account can have several Fruits but I want it to be listed only
once in one line showing all the fruits list on DD,DE,DF,DG,DH

Thats it.

Here is my code:

StartRow = 3
With Sheets("Tracker")
BigListRowCount = StartRow
SmallListStartRowCount = 8
SmalllistRowCount = SmallListStartRowCount
SmallListAccountNumber = 0
'**************** will need to check that From date is earlier
than To date*****
'Match until end of the database
TotalAttempts = 0
Do While .Range("BD" & BigListRowCount) < ""
'Found = False
'Match Date Between From and to and Cross = Yes
If .Range("BD" & BigListRowCount).Value
= .Range("DB4").Value And _
.Range("BD" & BigListRowCount).Value <= .Range("DD4").Value
And _
.Range("BG" & BigListRowCount).Value = True Then
'If list is empty start one
If SmalllistRowCount = SmallListStartRowCount Then
Found = True
.Range("DA" & SmalllistRowCount).Value = .Range("BA" &
BigListRowCount).Value
Select Case .Range("BH" & BigListRowCount).Value
Case "Apple"
TempColumnString = "DE"
Case "Orange"
TempColumnString = "DD"
Case "Grape"
Case "Pear"
TempColumnString = "DF"
Case "cherry"
End Select
.Range(TempColumnString & SmalllistRowCount).Value
= .Range(TempColumnString & SmalllistRowCount).Value + 1
Else
'Verify the list to see if account already exists
TempCountRow = SmalllistRowCount
Found = False
Do While TempCountRow = SmallListStartRowCount
'if Found account in the list, add to the Policy type
value
If .Range("DA" & TempCountRow).Value = .Range("BA" &
BigListRowCount).Value Then
Select Case .Range("BH" & BigListRowCount).Value
Case "Apple"
TempColumnString = "DE"
Case "Orange"
TempColumnString = "DD"
Case "Grape"
Case "Pear"
TempColumnString = "DF"
Case "cherry
.Range(TempColumnString & TempCountRow).Value
= .Range(TempColumnString & TempCountRow).Value + 1
Found = True
Exit Do
Else
TempCountRow = TempCountRow - 1
End If

Loop
'No account found in the list
If Found = False Then
.Range("DA" & SmalllistRowCount).Value = .Range("BA" &
BigListRowCount).Value
Select Case .Range("BH" & BigListRowCount).Value
Case "Apple"
TempColumnString = "DE"
Case "Orange"
TempColumnString = "DD"
Case "Grape"
Case "Pear"
TempColumnString = "DF"
Case "cherry
.Range(TempColumnString & SmalllistRowCount).Value
= .Range(TempColumnString & SmalllistRowCount).Value + 1
Found = True
End If
End If
If Found = True Then
TotalAttempts = TotalAttempts + 1
SmalllistRowCount = SmalllistRowCount + 1
End If
End If
BigListRowCount = BigListRowCount + 1
Loop
End With

=====
It works, but I am no expert in coding and I was wondering if it could
be optimized to be faster/smaller?
Any sugestions are welcome.
Thanks