Autofilter criteria value in VBA - excel

I have a table with activated autofilter mode and it is known that only Criteria1-type filtering is applicable (i.e. items of interest are implicitly indicated). My goal is to extract a criteria list for each column in VBA. I used IsArray(.Filters(i).Criteria1) to determine if there is more than 1 item selected for a particular column and everything works fine when either 1 or more than 2 items are selected. However, when I select 2 items, .Filters(i).Criteria1 is not recognized as an array for some reason. .Filters(i).Criteria1 returns only the item that is higher in the list.
Could anyone explain me: why is it so and what is the best way to deal with this problem?

This is an old as question, but in case anyone ends up confused here, confused.
With the a filters object (part of the worksheet.autofilter.filters collection probably)
Here is 1 happens:
1 filter on a column:
filters(i).criteria1 is a string
2 filters on a column:
filters(i).criteria1 is a string
filters(i).criteria2 is a string
3 or more filters on a column:
filters(i).criteria1 is an array of strings (which is a variant)
filters(i).criteria2 doesn't exist
This isn't that clear from MSDN, but it's what happens. My only guess is that in past versions of excel it wasn't possible to add more than 1 filter criteria, and so the old criteria1 and criteria2 types were maintained for backwards compatibility. Still though, it's a stupid system.
Which means that the only way to get the filter properties (as far as I can see) is as follows:
For Each f In ActiveSheet.AutoFilter.Filters
If f.On Then
If IsArray(f.Criteria1) Then
cA = f.Criteria1
Else
c1 = f.Criteria1
On Error Resume Next
c2 = f.Criteria2
On Error GoTo 0
End If
End If
Next
Because Criteria2 errors for both IsEmpty(f.Criteria1) and IsNull(f.Criteria1) so as far as I can see the only way to check if it exists is with an ugly on error resume next

Related

Is there a way to "Select all" the Apply Names in Excel?

In Formulas->Define Name->Apply Names, I have thousands of custom named cells in the listbox. It is inefficient to select them allone by one. Is there a way, by setting in Excel or VBA code, to select them all? CTRL+A and SHIFT PgUp/Dn doesn't work.
In UserForm_Initialize(), I applied Cells.ApplyNames but error says 'Runtime error 1004, Microsoft Excel cannot find references to replace'
The documentation at msdn.microsoft.com says
Names: An array of the names to be applied. If this argument is omitted, all names on the sheet are applied to the range.
see https://msdn.microsoft.com/en-us/library/office/ff196578(v=office.15).aspx
Following on that try this:
Selection.ApplyNames _
IgnoreRelativeAbsolute:=True, UseRowColumnNames:=True, _
OmitColumn:=True, OmitRow:=True, Order:=1, AppendLast:=False
This should work depending on the Scope of the Defined Names and their visibility. Try that and let us know the results.
I found that combining a for loop with the ApplyNames Function worked for me.
Sub ApplyNames()
On Error Resume Next
Count = ActiveWorkbook.Names.Count
For i = 1 To Count
Name = ActiveWorkbook.Names.Item(i).Name
Cells.applynames Names:=Array(Name), IgnoreRelativeAbsolute:=False
Next i
End Sub
It counts the number of names then loops through them individually.
For some reason leaving the names variable empty didn't work in my situation, I think it was because there were errors in some of the names.

Vlookup based on criteria

The data I have in my "entity sheet"
entity id
source id
source entity id
HR0001
GOP
1200
HR0002
WSS
WSS1201
HR0003
GOP
1201
HR0004
WSS-T
WSST1202
HR0005
GOP
1202
HR0006
GOP
1203
HR0007
WSS-S
WSSS1203
HR0008
GOP
1204
HR0009
GOP
1205
HR0010
GOP
1206
HR0011
WSS-R
WSSR1204
HR0012
WSS-T
WSST1205
HR0013
WSS-S
WSSS1206
HR0014
GOP
1207
HR0015
WSS-T
WSSS1207
HR0006
WSS-S
WSSS1208
HR0007
GOP
1208
HR0008
WSS-R
WSST1209
HR0009
WSS-S
WSSS1210
In my working sheet, I need the source entity id (column c) data, by doing a VLOOKUP on the entity id (column A), based on source id (column b). that is I need only those beginning with "WS" IDs on my working sheet. My code is
Sub Test()
Worksheets("working sheet").Activate
Dim sht, sht1 As Worksheet
Dim i As Long, LR As Long
Set sht = ActiveWorkbook.Worksheets("working sheet")
Set sht1 = ActiveWorkbook.Worksheets("entity sheet")
LR = sht.UsedRange.Rows.Count
With sht
For i = 2 To LR
If InStr(sht1.Range("B" & i).Value, "WS") Then
sht.Range("B" & i).Value = (Application.VLookup(.Range("A" & i).Value, Worksheets("entity sheet").Range("A2:C5000"), 3, False))
End If
Next i
End With
End Sub
desired result - in the working sheet
entity id
source entity id - WSS
HR0001
HR0002
WSS1201
HR0003
HR0004
WSST1202
HR0005
HR0006
WSSS1208
HR0007
WSSS1203
HR0008
WSST1209
HR0009
WSSS1210
HR0010
HR0011
WSSR1204
HR0012
WSST1205
HR0013
WSSS1206
HR0014
HR0015
WSSS1207
Took me a little while but... I've got two different versions for you: one with VBA and one with just formulas.
With VBA
The issue you had was that VLOOKUP returns the first match but you needed to satisfy two criteria (that is: (i) match on entity id and (ii) match on source id begins with "WS").
This meant that you either had to:
use a formula that could match both criteria at the same time, OR
find all matches with the first criteria (e.g. with FIND) and then loop through the results to match the second criteria -- probably something like this: https://www.thespreadsheetguru.com/the-code-vault/2014/4/21/find-all-instances-with-vba
I selected option #1 as I expected it would make the code shorter.
To do this, I took advantage of a trick I've used in formulas before where I can use "&" between two ranges to match on two criteria at the same time. So, instead of matching "HR0012" first and then "WS-something" second, I match "HR0012WS-something" at once. (You can view this concept by pasting =A2:A20&B2:B20 in an empty column somewhere in your entity sheet.)
The following code assumes that your active worksheet is your working sheet. Paste this code behind your working sheet, then run it when you have that sheet open.
Public Sub tester()
Dim rg As Range
Dim sSourceEntityId As String
For Each rg In Range("A2:A16")
sSourceEntityId = Evaluate("=XLOOKUP(""" & rg.Value & "WS"",entity!A2:A20&LEFT(entity!B2:B20,2),entity!C2:C20,"""",0,1)")
If Len(sSourceEntityId) > 0 Then
rg.Offset(0, 1).Value = sSourceEntityId
End If
Next rg
End Sub
If the part inside the Evaluate is not clear, paste
=XLOOKUP(A1&"WS",entity!A2:A20&LEFT(entity!B2:B20,2),entity!C2:C20,"",0,1)
somewhere inside your working sheet to see it more clearly.
Also, note that you used Instr, which would find "WS" anywhere in the string. I used LEFT(value, 2)="WS" to be sure that I matched only the first 2 characters.
I also had to use XLOOKUP instead of VLOOKUP to allow me to use the LEFT(value, 2). If you're using an old version of Excel, you won't have XLOOKUP, unfortunately.
Without VBA
Paste this formula into A2 on your working sheet:
=IFERROR(INDEX(entity!$C$2:$C$20,AGGREGATE(15,3,((entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS")/(entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS"))*ROW(entity!$A$2:$A$20)-ROW(entity!$A$1),1)),"")
Then copy that formula down to every row that you want to do a match on. Just to be clearer, it will look like this:
This is a little complex. I based it on an approach in this article, which explains step-by-step how to use INDEX(.. AGGREGATE(..)) for multiple matches. Although it's pretty neat how it works, you may prefer the VBA approach as it is probably easier to maintain.
UPDATE:
I forgot to mention that there is a possibility that the IFERROR() in the formula may slow your spreadsheet down if you have many matches and rows. I also created a version of the formula that doesn't use IFERROR. It uses an IF to first check if there are any TRUE matches first before executing the INDEX.. AGGREGATE. You may not need it, but I've pasted it below just in case it's useful:
=IF(MAX(INT(entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS"))=1,INDEX(entity!$C$2:$C$20,AGGREGATE(15,3,((entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS")/(entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS"))*ROW(entity!$A$2:$A$20)-ROW(entity!$A$1),1)),"")
UPDATE 2:
The statement used in the VBA Evaluate will also work directly as a formula and is much simpler to understand. I realized this when I realized that a single valid match is okay (i.e. we don't need multiple matches):
=XLOOKUP(A2&"WS",entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2),entity!$C$2:$C$20,"",0,1)

Returning multiple values using Vlookup in excel

I have an excel sheet set up to automatically calculate meetings per day by day of the week. I would like to write a formula to return all dates I have a meeting scheduled (comma separated preferably), but I am having some difficulty. Using Vlookup, I can only get it to return the first date.
For example, here is what my data looks like:
A B C
Initial Meetings Follow-up Meetings Date
1 1 7/29/2015
0 1 7/30/2015
1 1 7/31/2015
0 0 8/1/2015
0 0 8/2/2015
I would like to write a formula to return "7/29/2015, 7/31/2015" in one cell, and "7/29/2015, 7/30/2015, 7/31/2015" in another, but I seem to be stuck.
You can't do this with vLookup.
This can be done relatively easily in a VB script, but it would affect portability as many if not most users disable macros by default and in many cases users are prevented from using Macros because their company disables them and makes it policy that users should not use them.
If you are OK with Macros, you can put the following into a new module and then use =MultiVlookup(lookup_value,table_array, col_index_num) in the same way as you'd use vlookup and it should give you a comma separated list of multiple matches:
Public Function MultiVlookup(find_value, search_range, return_row)
Dim myval ' String to represent return value (comma-separated list)
Dim comma ' Bool to represent whether we need to prefix the next result with ", "
comma = False
'Debug.Print find_value.value, return_row
For Each rw In search_range.Rows ' Iterate through each row in the range
If rw.Cells(1, 1).value = find_value Then ' If we have found the lookup value...
If comma Then ' Add a comma if it's not the first value we're adding to the list
myval = myval + ", "
Else
comma = True
End If
myval = myval + Str(rw.Cells(1, return_row).value)
End If
Next
MultiVlookup = myval
End Function
This may not be the cleanest way of doing it, and it isn't a direct copy of vlookup (for instance it does not have a fourth "range lookup" argument as vlookup does), but it works for my test:
Finally my original suggestion (in case it helps others - it's not the exact solution to the question) was:
I've not tried it myself, but this link shows what I think you might be looking for.
Great code, but don't forget to add the following is you use Option Explicit:
Dim rw As Range
WHEELS

Turning an excel formula into a VBA function

I'm a bit new to trying to program and originally was just trying to improve a spreadsheet but it's gone beyond using a basic function in excel. I have a table that I am having a function look at to find a building number in the first column and then look at start and finish dates in two other respective columns to find out if it should populate specific blocks on a calendar worksheet. The problem occurs because the same building number may appear multiple times with different dates and I need to to find an entry that matches the correct dates.
I was able to create a working though complicated formula to find the first instance and learned I can add a nested if of that formula again in the false statement with a slight change. I can continue doing that but it becomes very large and cumbersome. I'm trying to find a way to make a function for the formula with a variable in it that would look at how many times the it has already been used so it keeps searching down the table for an answer that fits the parameters.
This is currently my formula:
=IFERROR(IF(AND(DATE('IF SHEET (2)'!$F$7,MATCH('IF SHEET (2)'!$C$2,'IF SHEET (2)'!$C$2:'IF SHEET (2)'!$N$2,0),'IF SHEET (2)'!C$4)>=VLOOKUP("2D11"&1,A2:F6,4,0),DATE('IF SHEET (2)'!$F$7,MATCH('IF SHEET (2)'!$C$2,'IF SHEET (2)'!$C$2:'IF SHEET (2)'!$N$2,0),'IF SHEET (2)'!C$4)<=VLOOKUP("2D11"&1,A2:F6,4,0)),IF(VLOOKUP("2D11"&1,A2:F6,3,0)="2D11",VLOOKUP("2D11"&1,A2:F6,6,FALSE)),"NO ANSWER"),"ERROR")
Where you see 2D11&1 is where I need the variable for 1 so it would be "number of times it's been used in the function +1" then I could just loop it so it would keep checking till it ran out of 2D11's or found one that matched. I haven't posted before and I'm doing this through a lot of trial and error so if you need more info please post and say so and I'll try to provide it.
So rather than have someone try to make sense of the rediculous formula I posted I though I would try to make it simpler by just stating what I need to accomplish and trying to see how to turn that into a VBA function. So I'm kinda looking at a few steps:
Matches first instance of building name in column A with
building name for the row of the output cell.
Is date connected with the output cell >= start date of first entry(which is user entered in column D).
Is date connected with the output cell <= end date of first entry(which is user entered in column E).
Enters Unit name(located in column F) for first instance of the building if Parts 1, 2, and 3 are all True.
If parts 1, 2, or 3 are False then loops to look at next instance of the building name down column 1.
Hopefully this makes things clearer than the formula so I'm able to get help as I'm still pretty stuck due to low knowledge of VBA.
Here is a simple solution...
Building_name = ???
Date = ???
Last_Row = Range("A65536").End(xlUp).Row
For i = 1 To Last_Row
if cells(i,1).value = Building_Name Then
if date >= cells(i,4).value Then
if date <= cells(i,5).value Then
first instance = cells(i,6).value
end if
end if
end if
next
you should add a test at the end to avoid the case where there is no first instance in the table
If I understand correctly, you have a Table T1 made of 3 columns: T1.building, T1.start date, T1.end date.
Then you have 3 parameters: P1=building, P2=start date, P3=end date.
You need to find the first entry in table T1 that "fits" within the input parameters dates, that is:
P1=T1.building
P2<=T1.start date
P3>=T1.end date
If so, you can define a custom function like this
Public Function MyLookup(Key As Variant, DateMin As Variant, DateMax As Variant, LookUpTable As Range, ResultColumn As Integer) As Range
Dim iIndx As Integer
Dim KeyValue As Variant
Dim Found As Boolean
On Error GoTo ErrHandler
Found = False
iIndx = 1
Do While (Not Found) And (iIndx <= LookUpTable.Rows.Count)
KeyValue = LookUpTable.Cells(iIndx, 1)
If (KeyValue = Key) And _
(DateMin <= LookUpTable.Cells(iIndx, 2)) And _
(DateMax >= LookUpTable.Cells(iIndx, 3)) Then
Set MyLookup = LookUpTable.Cells(iIndx, ResultColumn)
Found = True
End If
iIndx = iIndx + 1
Loop
Exit Function
ErrHandler:
MsgBox "Error in MyLookup: " & Err.Description
End Function
That may not be the most performant piece of code in the world, but I think it's explanatory.
You can download this working example

Excel 2010: Macro for hidden column groups

VBA is not my particular strength, but here we go:
I would like to trigger a macro once a group of columns is hidden or shown. How can I archive this?
The results of my previous research
The only good hint about this I could find is this discussion at MSDN. Here, a solution is using the following way is drafted:
From the root dir of the xlsx file create a file customUI\customUI.xml with the content
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" >
<commands >
<command
idMso="ColumnsHide"
onAction="ColumnHide_onAction"/>
<command
idMso="ColumnsUnhide"
onAction="ColumnUnhide_onAction"/>
</commands >
</customUI >
and add
<Relationship Id="edTAB" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml" />
to the _rels\_rels.xml. (All this probably is much easier using Visual Studio, but I have no access to such sophisticated tools in the microsoft world...) Now, the macro can be used the following way:
Public Sub ColumnHide_onAction(control As IRibbonControl, ByRef cancelDefault)
'
' Code for onAction callback. Ribbon control command
'
MsgBox "Ribbon Column Hide"
cancelDefault = False
End Sub
Public Sub ColumnUnhide_onAction(control As IRibbonControl, ByRef cancelDefault)
'
' Code for onAction callback. Ribbon control command
'
MsgBox "Ribbon Column Unhide"
cancelDefault = False
End Sub
This approach perfectly catches hiding and unhiding of columns, but not hiding and unhiding of groups. So, close, but not quite there.
Downloading the possible idMso values from here, I got notice of the GroupViewShowHide control. Using this the same way as ColumnsHide or ColumnsUnhide does not archive the desired result, though.
Any ideas?
For hiding groups of columns, I've noticed you haven't used the .Hidden property in your code example. It can be quite useful, especially if you define a group of columns in an array. For example:
For byti = 0 To UBound(cols())
If Hide Then
ActiveSheet.columns(cols(byti)).EntireColumn.Hidden = True
...and so on.
To check if a group of columns is already hidden or not, you could also use an array. Group your columns by assigning them to an array, then compare your worksheet's current status (what columns are hidden, what are not) to that array.
The code below is a suggestion for starting, and you could adapt to your project. It doesn't require the customUI.xml file you mentioned in your question.
The key parts are the MyColumnCheck variant, which is used to check if columns are hidden, and the .Match method. This is the VBA equivalent of the Match spreadsheet function.
Working on this code taught me much about how to search within arrays, and the ups and downs of using Match versus other methods - such as Find and just looping through an array! This has been discussed in several posts already, see this one for a good example. I chose to do Match rather than a For...Next loop, although it would be easy to include a For..Next loop that checks if a hidden column is in a group you assign.
If you're wondering about the IfError statement:
Application.IfError(Application.Match(MyColumnCheck.Column, MyColumnArray, 0),...
... this is because using Match in VBA code is often somewhat tricky as mentioned here. Also, as #Lori_m wrote here, "Using Application without .WorksheetFunction returns a variant which allows for arrays in arguments and results."
Also, I chose to change the values of the group array to -1 as they were checked, so when the procedure was done a little simple math would reveal if all the columns referenced by the array were hidden. A negative number is better for this check because I'm assuming you would refer to an actual column with only positive numbers.
So, to sum up, .Match can be used effectively to check if the hidden columns on a worksheet match a group of columns defined by an array.
'the column group you're looking for, dim as a dynamic array of column numbers
Dim MyColumnArray(1) As Long
'MyColumnArray(0) is column 2 or "B", MyColumnArray(1) is column 3 or "C", etc
MyColumnArray(0) = 2
MyColumnArray(1) = 3
Dim MyColumnCheck As Variant 'column check
For Each MyColumnCheck In Worksheets("Sheet1").columns
'if the column is hidden and exists in MyColumnArray array...
If columns(MyColumnCheck.Column).EntireColumn.Hidden = True And _
Application.IfError(Application.Match(MyColumnCheck.Column, MyColumnArray, 0), 0) > 0 _
Then
MyColumnArray(Application.Match(MyColumnCheck.Column, MyColumnArray, 0) - 1) = -1
'... set that element of the MyColumnArray array to -1.
End If
Next
If WorksheetFunction.Sum(MyColumnArray) = 0 - (UBound(MyColumnArray) + 1) Then
Debug.Print "group MyColumnArray is hidden"
'execute code here for when the group is hidden
Else
Debug.Print "group MyColumnArray is visible"
'execute code here for when the group is visible
End If

Resources