You should clear "rgExtract" before applying AdvancedFilter.


--
Regards
Dave Hawley
www.ozgrid.com
"--elizabeth" wrote in message
...
Sorry. Thought I had. Here it is (I hope):
--elizabeth

Private Sub cmdSearch_Click()
Dim rgDB As Range
Dim rgCriteria As Range
Dim rgExtract As Range

Set rgDB = Range("Database")
Set rgCriteria = Range("Criteria")
Set rgExtract = Range("Extract")

WriteValues2CritRng

rgDB.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rgCriteria, _
CopyToRange:=rgExtract
End Sub

Private Sub WriteValues2CritRng()
Dim iRow, iCol As Integer
Dim rngCell As Range
With Worksheets("Search Criteria")
'columns 4 and 8 (offsets 3 and 7) are calculated fields
'first row of criteria
Range("$A$3").Activate
ActiveCell = cboMaker1
With ActiveCell
.Offset(0, 1) = txtBeginYear1
.Offset(0, 2) = txtEndYear1
.Offset(0, 4) = cboSmoked1
.Offset(0, 5) = txtMinValue1
.Offset(0, 6) = txtMaxValue1
.Offset(0, 8) = cboStyle1
.Offset(0, 9) = cboBowlFinish1
.Offset(0, 10) = cboGrain1
.Offset(0, 11) = cboStemMaterial1
.Offset(0, 12) = cboOriginalStem1
.Offset(0, 13) = cboMakerMark1
.Offset(0, 14) = cboBoxCase1
.Offset(0, 15) = cboCondition1
End With
'second row of criteria
Range("$A$4").Activate
ActiveCell = cboMaker2
With ActiveCell
.Offset(0, 1) = txtBeginYear2
.Offset(0, 2) = txtEndYear2
.Offset(0, 4) = cboSmoked2
.Offset(0, 5) = txtMinValue2
.Offset(0, 6) = txtMaxValue2
.Offset(0, 8) = cboStyle2
.Offset(0, 9) = cboBowlFinish2
.Offset(0, 10) = cboGrain2
.Offset(0, 11) = cboStemMaterial2
.Offset(0, 12) = cboOriginalStem2
.Offset(0, 11) = cboMakerMark2
.Offset(0, 14) = cboBoxCase2
.Offset(0, 15) = cboCondition2
End With
'third row of criteria
Range("$A$5").Activate
ActiveCell = cboMaker3
With ActiveCell
.Offset(0, 1) = txtBeginYear3
.Offset(0, 2) = txtEndYear3
.Offset(0, 4) = cboSmoked3
.Offset(0, 5) = txtMinValue3
.Offset(0, 6) = txtMaxValue3
.Offset(0, 8) = cboStyle3
.Offset(0, 9) = cboBowlFinish3
.Offset(0, 10) = cboGrain3
.Offset(0, 11) = cboStemMaterial3
.Offset(0, 12) = cboOriginalStem3
.Offset(0, 11) = cboMakerMark3
.Offset(0, 14) = cboBoxCase3
.Offset(0, 15) = cboCondition3
End With
End With
With Range("Criteria")
For iRow = 3 To 5
For iCol = 1 To 16
Set rngCell = Cells(iRow, iCol)
If IsEmpty(rngCell) Then
rngCell = ""
End If
Next iCol
Next iRow
End With
End Sub