Adv Filter fails in macro, works manually

[Dave Peterson]

Oops. The URL expired before I got to it.

Remember to change that "Expire in" box to some more reasonable <vbg>.

 

[joel]

You code is creating a very large databae which slow down the cod
significantly. I added some code in THISWORKBOOK to eliviate thi
problem.

Public Sub Workbook_Open()
' Set WS_INV = Worksheets("Inventory")
' Set WS_DATA = Worksheets("Data Validation Lists")
' Set WS_CRIT = Worksheets("Search Criteria")
' WS_DATA.Activate

Dim LastRow
With Worksheets("Inventory")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("Database").Name.RefersTo = "=Inventory!A1:A" & LastRow
End With

'Load frmAddPipe
Load frmSearchPipes
'frmAddPipe.Show
frmSearchPipes.Show


Th code above is redefining the named range Database to only includ
the lnumber of lines in the databae rather than every row in th
worksheet (65536). See if this helps.

 

[--elizabeth]

Sorry. If at first you don't succeed....

http://senduit.com/6165d6

 

[Dave Peterson]

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

 

[Dave Peterson]

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"

 

[--elizabeth]

Dave, thank you so much. Our company from Spain is leaving tomorrow morning,
so I won't have time to try your code until then.
--elizabeth

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"

 

[--elizabeth]

Thanks, Joel. I had become aware of this but hadn't dealt with it yet. Thanks
for your code.
--elizabeth

 

[--elizabeth]

Dave, I still can't get it to work. <sigh> First, I tried correcting my code
to incorporate your changes. Then I gave up and just copied your code over
mine. And it still doesn't work for me. I uploaded the file again:

http://senduit.com/ef64fe

Oh, and I changed the Year column headers in the database, criteria and
extract ranges to "Year Made".

When we do finally get it working, though, I will incorporate your
suggestions of a separate sheet for the extract range.

Will the following lines of code work in the WriteValues2CrigRng function?

If Not .Offset(0, 1) = vbNullString Then .Offset(0, 1) =
CLng(txtBeginYear1)

If Not .Offset(0, 5) = vbNullString Then .Offset(0, 5) =
FormatCurrency(txtMinValue1, 0)

And why is long better than integer? I see long or doubles used a lot in
people's codes, but rarely integer.

One more question: I wrote the code at the bottom of WriteValues2CritRng,
thinking that vbNullString could be the problem in that the form's empty
comboboxes weren't transferring to the spreadsheet correctly somehow. So I
changed the vbNullStrings to "". And in cmdNew, I again used "" instead of
vbNullString. Is that necessary? A good idea? Which is better--vbNullString
or ""?

Thanks, again, Dave, for all your help.

--elizabeth

 

[Dave Peterson]

First, I forgot to mention that I unprotected the Inventory sheet.

But I think you've got a couple of problems with the criteria. If you have a
field (like Year) that you want to check to see if it's at least 1945 and at
most 1954, you have to use criteria like:

Year Year

=1945 <=1954

Yep. Two columns.

Debra Dalgleish explains it here:
http://contextures.com/xladvfilter01.html
look for: Extract Items in a Range

She uses dates, but the technique is similar.

I added some stuff that checks for numbers in those year fields and value fields
and creates a couple of extra columns of info based on what's found (two pair of
two columns, actually).

I saved the workbook with the criteria in it--but you have to disable macros to
see it (since you want to display that userform when you start).

And since you used nice names (like txtMinYear1, txtminyear2, txtminyear3), it
makes it pretty easy to loop through the controls.

I can use a loop to get to the 3 comboboxes for the maker field with something
like:

for iRow = 1 to xxx
.Offset(iRow, 1).Value = Me.Controls("cboMaker" & iRow).Value


Then I don't have to use pretty much redundant code to get all those controls.

(And adding the 4th line for your filter should be a bit easier <vbg>.)

I've uploaded a new copy of your workbook (with a different name) to that same
site (with a 1 day time limit).

http://senduit.com/0d0279


It seems to work ok for me in my little tests.

If you decide you don't want to publicly share your workbook, you can send it
direct to me. Remove XSpam from my email address. (It's munged so that the
spambots that scrape the newsgroups get a fake email id.)

 

[Dave Peterson]

I forgot about your followup questions...

With modern computers, using Integers/singles doesn't make sense. I've read
that the pc works with longs and doubles anyway--so why give it something to
convert?

And I've always used "", but that's simply because it's easier to type.

I don't think it matters in most cases.

One more thing I did do is eliminate populating the controls with those "" (or
vbnullstring's) when it loads. Unless you did something strange (like changing
a property in the property window), those controls will be blanks/null strings
to start.




--elizabeth wrote:

 

[--elizabeth]

Dave, I cannot thank you enough. It will take me a little while to absorb
your changes, but everything seems to be working.
--elizabeth

 

[Dave Peterson]

Make sure you keep backups when you're making changes <vbg>.

 

[Dave Peterson]

ps.

I forgot to tell you that I removed a reference to the Web component stuff. I
don't have that and it was causing compile errors.

 

[--elizabeth]

Dave, I copied/pasted all the code from the test file over to my "real" file.
If I search on Maker, MinVal and MaxVal criteria --i.e., Baldo Baldi, 200,
600--the results are displayed.

However, if I search on Maker, MinYear and MaxYear criteria--i.e., Baldo
Baldi, 1920, 1940--no results are displayed.

The code works fine for both MinVal/MaxVal and MinYear/MaxYear in your test
file, but not in mine. I've tried to discover why on my own, unsuccessfully.

The Search Criteria and Extract Results sheets are created programmatically,
so I don't see how that could be the problem.

The MinYear/MaxYear values are written to the Search Criteria sheet the same
as the MinVal/MaxVal values.

I'm stumped. May I please have the benefit of your knowledge and experience
again?

I uploaded the file and it's good for three days. I'm going to be at my
MIL's in the country and the internet there is dial-up, so I may not have
access until I return on Monday. So if you get this before then and have time
to address it, and I don't get back to you in a timely fasion, that's why.

http://senduit.com/94d368

Thanks,
--elizabeth

 

[Dave Peterson]

In a private email...

First, I'm not sure if you saw this, but I removed the reference to the web
component stuff. I don't have that installed and it was causing compile errors
for me.

Second, I'm not sure if I told you (sorry), but I converted those years in the
inventory worksheet to real numbers (from text). When I did that with your
newest workbook, it worked fine.

You have some bad values in the inventory sheet, too.

One way to fix these problems...
Select an empty cell
Edit|copy
Select column C and E on the Inventory sheet
Edit|paste special|check Add and values
(with that worksheet unprotected)

You should see excel's error checking warning (top left corner of the offending
cell) go away -- well, if you have it turned on.

And you may want to change your Workbook_open procedure.