One more thing...
I've always thought that it's better to use more sheets than try to jam things
into a single sheet.
You may want to consider moving the criteria range to its own worksheet (and
hide it???) and the extraction range to its own worksheet. It shouldn't be too
many changes to your code.
And it may make creating the criteria range easier--just clear the entire sheet:
with worksheets("criteria")
.range("2:" & .rows.count).clear
end with
And with the extraction sheet:
With worksheets("Extract")
.cells.clear
end with
or even create the sheet from scratch each time:
on error resume next
application.displayalerts = false
worksheets("extract").delete
application.displayalerts = true
on error goto 0
set rgextract = worksheets.add.range("A1")
rgextract.parent.name = "Extract"
Dave Peterson wrote:
First, I opened the workbook and saw a problem with a formula in the "Search
Criteria" worksheet in column D
=AND(Inventory!Year=B3, Inventory!Year <=C3)
I'm not sure where you're located and I'm not sure what you're trying to do, but
Year shouldn't be used as a Name in English versions of excel. It looks way too
much like the =year() worksheet function.
But that wasn't important to the problem...
Second, I only tested with two criteria (Maker:=Baldo-Baldi and Beg Yr:=1952).
Then I added some dots to ranges that you missed qualifying. And I moved some
code into the appropriate with/end with lines (adding dots <vbg). But that
wasn't enough.
I changed the way the that the rgDB was created (I wouldn't use the entire
row--with all those empty cells in row 1:
With Worksheets("Inventory")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rgDB = .Range("A1", .Cells(LastRow, LastCol))
rgDB.Name = "'" & .Name & "'!DataBase"
End With
But that didn't fix the problem either...
So I made sure that the dates/numbers were really treated as numbers.
With .Range("A3")
.Value = cboMaker1
.Offset(0, 1) = CLng(txtBeginYear1)
I only made this single change to the numeric entries. You'll want to validate
the entries before you blindly use clng(), too. (But it was sufficient for my
testing.)
And then I clicked the button (I added a button to show the userform modelessly
(so I could see behind it when I was looking for stuff) and I got info in the
extract range.
Here's the entire code from behind the userform:
Option Explicit
Private Sub cmdSearch_Click()
Dim rgDB As Range
Dim rgCriteria As Range
Dim rgExtract As Range
Dim LastRow As Long
Dim LastCol As Long
With Worksheets("Inventory")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rgDB = .Range("A1", .Cells(LastRow, LastCol))
rgDB.Name = "'" & .Name & "'!DataBase"
End With
Set rgCriteria = Worksheets("Search Criteria").Range("Criteria")
Set rgExtract = Worksheets("Search Criteria").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
With .Range("A3")
.Value = cboMaker1
.Offset(0, 1) = CLng(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
With .Range("A4")
.Value = cboMaker2
.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
With .Range("A5")
.Value = cboMaker3
.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
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 With
End Sub
Private Sub cmdNew_Click()
Dim iRow, iCol As Integer
Dim ctl As Control
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = vbNullString
End If
Next ctl
Worksheets("Search Criteria").Activate
With Worksheets("Search Criteria")
For iRow = 3 To 5
For iCol = 1 To 14
If Not (iCol = 4 Or iCol = 8) Then
.Cells(iRow, iCol) = ""
End If
Next iCol
Next iRow
.Range("ExtractRows").Clear
End With
End Sub
Private Sub UserForm_Initialize()
'initialize all controls to vbNullString
Dim ctl As Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl = vbNullString
Case "ComboBox"
ctl = vbNullString
Case "ListBox"
ctl = vbNullString
End Select
Next ctl
cmdCriteria.Caption = "Multiple Criteria"
CriteriaRow
Worksheets("Search Criteria").Activate
End Sub
Private Sub cmdCriteria_Click()
If cmdCriteria.Caption = "Multiple Criteria" Then
MultipleCriteriaRows
cmdCriteria.Caption = "Criteria"
Else
CriteriaRow
cmdCriteria.Caption = "Multiple Criteria"
End If
End Sub
Private Sub MultipleCriteriaRows()
Dim ctl As Control
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
If ctl.Tag = 2 Or ctl.Tag = 3 Then
ctl.Visible = True
End If
End If
Next ctl
End Sub
Private Sub CriteriaRow()
Dim ctl As Control
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
If ctl.Tag = 2 Or ctl.Tag = 3 Then
ctl.Visible = False
End If
End If
Next ctl
End Sub
--elizabeth wrote:
Sorry. If at first you don't succeed....
http://senduit.com/6165d6
--
Dave Peterson
--
Dave Peterson