I am trying to return the columns count on a range, sometimes I need one range, but, sometimes I need more than one range.
I have put in optional ranges so I can choose multiple ranges. If I reference a range in the function prototype that I have not supplied in the spreadsheet I get the #Value! error.
I need a way to check if the optional ranges are null, void empty etc. so I don't have to reference the range.
This is the VBA Function Prototype:-
Function GetColoumnCount(ARange1 As Range, Optional ARange2 As Range, Optional ARange3 As Range, Optional ARange4 As Range) As Integer
Dim Result As Integer
Result = 0
Result = ARange1.Columns.Count ' This works
Result = ARange1.Columns.Count + ARange2.Columns.Count ' This doesn't work
GetColoumnCount = Result
End Function
In my spreadsheet I have to enter this in a cell for the function to work.
=GetColoumnCount(BC34:BK34, BC35:BD35, BE35:BF35, BG35:BH35)
this defeats the purpose of having optional arguments.
Try it like this
Function GetColoumnCount(ARange1 As Range, Optional ARange2 As Range, Optional ARange3 As Range, Optional ARange4 As Range) As Long
Dim Result As Long
Result = 0
Result = ARange1.Columns.Count ' This works
If Not ARange2 Is Nothing Then
Result = Result + ARange2.Columns.Count
End If
GetColoumnCount = Result
End Function
If you use the ParamArray keyword in the arguments you can supply a variable number of arguments.
Public Function GetColumnCount(ParamArray Ranges() As Variant) As Long
Dim lReturn As Long
Dim i As Long
Dim rResult As Range
Dim rArea As Range
'Loop through the Ranges array supplied by ParamArray
For i = LBound(Ranges) To UBound(Ranges)
'Only work with those array members that are ranges
If TypeName(Ranges(i)) = "Range" Then
'Use Union to combine all the ranges
If rResult Is Nothing Then
Set rResult = Ranges(i)
Else
Set rResult = Application.Union(rResult, Ranges(i))
End If
End If
Next i
'Loop through the Areas and add up the columns
If Not rResult Is Nothing Then
For Each rArea In rResult.Areas
lReturn = lReturn + rArea.Columns.Count
Next rArea
End If
GetColumnCount = lReturn
End Function
To use:
=getcolumncount(E2:K18) = 7
=getcolumncount(D4:L14,N4:P14) =12 (9+3)
=getcolumncount(C7:F15,H7:L15,K7:N15) =11 (omits double counting overlap)
Related
So I'm aware that Sheets2!A:A Refers specifically to the whole of column A within the Sheet 2 workbook.
However, how do you actually process this when it's passed through a function?
Function Function1(cellValue As Variant, cellList As Range) As Variant
Dim cellContent As Variant
Dim list As Range
Dim i As Integer
cellContent = Sheets("Sheet1").Range(CStr(cellValue)).Value2
list = Range(cellList).Value2
For i = 1 To list
If i = cellContent Then
Function1 = "Found"
Else
Function1 = "Unfound"
End If
Next i
End Function
How would you parse Sheets2!A:A so that it uses the sheet specified and then the range of values in A:A.
I'm using a function so therefore it's effectively being passed through by the user as
=#Function1(A2,Sheet2!A:A)
the range is already a range:
Function Function1(cellValue As range, cellList As Range) As Variant
Dim cellContent As Variant
Dim list As Variant
Dim i As Long
cellContent = cellvalue.Value2
list = intersect(cellList.parent.usedrange,celllist).Value2
Function1 = "Unfound"
For i = 1 To ubound(list,1)
If list(i,1) = cellContent Then
Function1 = "Found"
Exit Function
End If
Next i
End Function
But this just reinvents MATCH:
=IF(ISNUMBER(MATCH(A2,Sheet2!A:A,0)),"Found","Unfound")
I need to create a formula in VBA where it need to have the option of iferror.
Basically my formula in Excel would be:
Iferror(vlookup(A1&A2;A:B;2;FALSE);vlookup(A1;P:Q;2;FALSE))
Then I tried to replicate that into only one formula in VBA
Function DestAcc ( Account as string, FA as string)
Dim rng1,rng2 as range
With Workbooks(“ACCOUNTS”).worksheets(“Accounts”)
Set rng1=.Range(.cells(1,1),cells(50000,2)
Set rng2=.Range(.cells(1,16),cells(50000,17)
DestAcc=WorksheetFunction.IfError(WorksheetFunction.VLookup(Account & FA, rng1, 2, False), WorksheetFunction.VLookup(Account, rng2, 2, False))
End function
Then in the Workbook I put on an empty cell
=DestAcc(C1;D1)
And I get the result #VALUE
If I try the 2 members individually I get a result, if I try the function with the "IfError" I always get #VALUE.
Can someone help me?
Thank you
Give this a try.
instead of using worksheetfunction use application
UPDATE: Set the reference to the workbook with the extension
Function DestAcc(Account As String, FA As String)
Dim accountsWorkbook As Workbook
Dim accountsWorksheet As Worksheet
Dim accountsWithFARange As Range
Dim AccountsOnlyRange As Range
Dim resultAccountFA As Variant
Dim resultAccount As Variant
Set accountsWorkbook = Workbooks("Accounts.xlsm")
Set accountsWorksheet = accountsWorkbook.Worksheets("Accounts")
With accountsWorksheet
Set accountsWithFARange = .Range("$A$1:$B$50000") ' $A$1:$B$50000
Set AccountsOnlyRange = .Range("$P$1:$Q$50000") ' $P$1:$Q$50000
End With
resultAccountFA = Application.VLookup(Account & FA, accountsWithFARange, 2, False)
resultAccount = Application.VLookup(Account, AccountsOnlyRange, 2, False)
DestAcc = IIf(Not IsError(resultAccountFA), resultAccountFA, resultAccount)
End Function
Note:
Your code has a couple of flaws:
You are defining rng1 as variant (this Dim rng1,rng2 as range is not the same as Dim rng1 as range, rng2 as range)
You are not closing the With block (missing End With)
Some suggestions:
- Always define the variables types (even if you're expecting a variant result)
Try to name your variables to something anybody can understand (rng1 doesn't mean much)
Try to write short lines (the iferror mixed with the worksheetfunction.vlookup could be splitted in two)
The way you are setting the ranges is difficult to read. you can use Set rng1 = .Range($A$1:$B$50000)
let me know if it works.
A Conditional Consecutive LookUp
Put all three procedures in a standard module (e.g. Module1) of the
workbook containing this code.
Adjust luAccount, luFA and ws.
Note: You have to use the extension of the open workbook (.xlsm, .xlsx, .xls)
This solution ignores case i.e. A=a.
You already know how to use it in Excel.
The Code
Option Explicit
' A Conditional Consecutive Lookup
Function DestAcc(Account As String, FA As String)
Application.Volatile
Dim luAccount As Variant, luFA As Variant
' Specify: First Rows, Match Columns, Value Columns
luAccount = Array(1, 1, 2)
luFA = Array(1, 16, 17)
Dim ws As Worksheet
' Either on the ActiveSheet:
'Set ws = Cells.Worksheet ' or Application.ThisCell.Worksheet
' or on a specified worksheet:
On Error GoTo exitProcedure
Set ws = Workbooks("Accounts.xlsm").Worksheets("Accounts")
On Error GoTo 0
Dim rng As Range
Dim vMatch As Variant, vValue As Variant
Dim MatchIndex As Long
Dim Criteria As String
' 1st LookUp
Set rng = getPartialColumn(ws, luAccount(0), luAccount(1))
If rng Is Nothing Then GoTo SecondLookUp
vMatch = rng: vValue = rng.Offset(, luAccount(2) - luAccount(1))
Criteria = Account & FA: GoSub findMatch
' 2nd LookUp
SecondLookUp:
Set rng = getPartialColumn(ws, luFA(0), luFA(1))
If rng Is Nothing Then GoTo exitProcedure
vMatch = rng: vValue = rng.Offset(, luFA(2) - luFA(1))
Criteria = Account: GoSub findMatch
GoTo exitProcedure
findMatch:
MatchIndex = getMatchIndex(Criteria, vMatch)
If MatchIndex > 0 Then GoTo returnLookup
Return
returnLookup:
DestAcc = vValue(MatchIndex, 1)
GoTo exitProcedure
exitProcedure:
End Function
' Returns the column range from a specified row to the last non-empty row.
Function getPartialColumn(WorksheetObject As Worksheet, _
Optional ByVal FirstRowNumber As Long = 1, _
Optional ByVal columnNumber As Long = 1) As Range
Dim rng As Range
With WorksheetObject
Set rng = .Columns(columnNumber).Find(What:="*", _
LookIn:=xlFormulas, SearchDirection:=xlPrevious)
If rng Is Nothing Then Exit Function
Set getPartialColumn = .Range(.Cells(FirstRowNumber, columnNumber), rng)
End With
End Function
' Returns the index of a found value in an array, or 0 if not found.
Function getMatchIndex(MatchValue As Variant, MatchArray As Variant) As Long
If Not IsError(Application.Match(MatchValue, MatchArray, 0)) Then
getMatchIndex = Application.Match(MatchValue, MatchArray, 0)
End If
End Function
How do I include a vlookup into my current set of code to do a countif of all vlookup results across all similar sheets. The codes I have will attempt to perform countif across sheets for one specified cell or a whole range of data in a column or row. Instead, I would like the below function to have the capability to count the number of vlookup result in a column across sheets of similar name.
Function myCountIfSheet1(rng As Range, criteria) As Long
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "Sheet1*" Then
myCountIfSheet1 = myCountIfSheet1 + WorksheetFunction.CountIf(ws.Range(rng.Address), criteria)
End If
Next ws
End Function
Public Function shifted_lookup(lookup_value As Variant, table_array As Range, column_index As Integer, range_lookup As Integer) As Variant
Dim curr_wsname As String, oth_wsname As String
Dim curr_ws As Worksheet, oth_ws As Worksheet
Set curr_ws = ActiveSheet
curr_wsname = curr_ws.Name
oth_wsname = Right(curr_wsname, 3)
Set oth_ws = Worksheets(oth_wsname)
Dim src_rng_base As String, src_rng As Range
src_rng_base = table_array.Address
Set src_rng = oth_ws.Range(src_rng_base)
Dim aux As Variant
shifted_lookup = Application.WorksheetFunction.VLookup(lookup_value, src_rng, column_index, range_lookup)
End Function
This ought to do the job. Please try it.
Function myCountIfSheet1(Rng As Range, _
Clm1 As Long, _
Crit1 As Variant, _
Clm2 As Long, _
Crit2 As Variant) As Long
' 011
Dim Fun As Long ' function return value
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
With Ws
If .Name Like "Sheet1*" Then
Fun = Fun + WorksheetFunction.CountIfs( _
.Range(Rng.Columns(Clm1).Address), Crit1, _
.Range(Rng.Columns(Clm2).Address), Crit2)
End If
End With
Next Ws
myCountIfSheet1 = Fun
End Function
For ease of calling, I have structured the function call to provide one range address only. In my tests I used A1:D30. Column(A) contained one criterium, Column(D) the other. Of course, column(A) is the first column - Columns(1) - of the range and column D is Columns(4) of the range. So, the following function call would look for "3" in column A and "red" in column D.
Debug.Print myCountIfSheet1(Range("A1:D30"), 4, "red", 1, 3)
The sequence of the criteria is immaterial. You can also add more criteria using the same structure.
Function AndSearch1(ByRef target As Range, ParamArray searchList() As Variant) As Boolean
'AND Boolean logic search using a hardcoded list
Dim i As Long
For Each cell In searchList
i = InStr(target.Value, cell): If i = 0 Then AndSearch1 = False: Exit Function
Next
AndSearch1 = True
End Function
Function AndSearch2(ByRef target As Range, ByRef searchList As Range) As Boolean
'AND Boolean logic search using a list Range
Dim i As Long
For Each cell In searchList
i = InStr(target.Value, cell): If i = 0 Then AndSearch2 = False: Exit Function
Next
AndSearch2 = True
End Function
The following will work fine within Excel:
=AndSearch1(A1,"red","white","blue")
where red, white and blue are within cells B1:B3
=AndSearch2(A1,B1:B3)
But is it possible to code a single AndSearch function so that it can receive either the hardcoded strings or the Range?
Sadly, VBA does not have anything like function/method overloads.
I have not tested this, but I think it should work for the two specific cases (either a paramarray of string literal, or a single range object):
Function AndSearch1(ByRef target As Range, ParamArray searchList() As Variant) As Boolean
'AND Boolean logic search using a hardcoded list
Dim i As Long
Dim myArray as Variant
myArray = searchList
If UBound(searchList) = 0 Then
If TypeName(searchList(0)) = "Range" Then
If searchList(0).Rows.Count = 1 and searchList(0).Columns.Count > 1 Then
myArray = Application.Transpose(Application.Transpose(searchList(0).Value))
ElseIf searchList(0).Rows.Count > 1 and searchList(0).Columns.Count = 1 Then
myArray = searchList(0).Value
Else
'you'd need additional logic to handle 2-dimensional ranges
End If
End If
End If
For Each cell In myArray # iterate the myArray instead of the searchList
NOTE: I don't think this will work (but could be revised to handle different edge cases) if you pass a ParamArray of ranges, like:
=AndSearch1("A1:B1","C2:C15")
Nor if it's a 2-dimensional range.
=AndSearch1("A1:D4")
But it could be adapted for those cases, the idea is to just take whatever argument(s) the function receives, and assign them to an appropriately iterable one-dimensional Variant.
I have an excel VBA Function that needs to count the cells that are coloured, match a specific string and have another cell blank.
I created it in a test workbook using only a small sample of the data where it worked, but now, when I implement in the main workbook, it returns #Value! I suspect there could be an issue with the string being used, but putting a watch on all my variables shows the function is working as expected but it doesn't actually provide the return value.
Here is the code. Any input will be very much appreciated
Function FundInStarted(rSample As Range, rKRM As Range, rColNum As Range, rArea As Range) As Long
Dim rAreaCell As Range
Dim lMatchColor As Long
Dim lCounter As Long
Dim sKRMMatch As String
Dim lColNumOff As Long
lMatchColor = rSample.Interior.Color
sKRMMatch = rKRM.Value2
lColNumOff = rColNum
For Each rAreaCell In rArea
If rAreaCell.Interior.Color = lMatchColor And rAreaCell.Offset(0, -lColNumOff) = sKRMMatch And rAreaCell.Value = "" Then
lCounter = lCounter + 1
End If
Next
FundInStarted = lCounter
End Function