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.
Related
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
I'm trying sort a predetermined range of cells from a UserForm (let's say A1:A5) using an array size as an integer, and the array itself. I've checked out 20+ links without finding a solution.
The code below successfully gets the values of the array (for my testing there are five doubles), pastes them into the worksheet sheetOperations (I always use code-targeted sheets to minimize issues). So the sheet targeting works, and the looping through the array and getting the values works.
Sorting the range (A1:A5) hasn't been successful. I've tried a variety of code. I'm trying to get A1 to A5 (on that specific worksheet) to list the previous values in the range in descending order - when I run this code (I tried ascending, descending) it has given me various errors such 1004, etc.
If A1:A5 is {1,3,2, 4, 6}, I want it to make A1:A5 {6,4,2,3,1}.
Sub timeStampStorePart2(ByRef doubleArray() As Double, ByVal size As Integer)
Dim ws As Worksheet
Dim wsFound2 As Worksheet
For Each ws In ThisWorkbook.Worksheets
If StrComp(ws.CodeName, "sheetOperations", vbTextCompare) = 0 Then
Set wsFound2 = ws
'MsgBox ("Found")
End If
Next ws
Dim loopInt As Integer
Dim arrayInt As Integer
Dim rangeAddress As String
arrayInt = 0
loopInt = 1
For loopInt = 1 To size
rangeAddress = "A" & loopInt
wsFound2.Range(rangeAddress).Value = doubleArray(arrayInt)
arrayInt = arrayInt + 1
Next loopInt
'rangeAddress = "A1:" & rangeAddress
'MsgBox (rangeAddress)
'Dim dataRange As Range
'Set dataRange = wsFound2.Range(rangeAddress)
wsFound2.Range("A1:A5").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlNo
End Sub
In answer to your question, here is a pretty simple code that sorts the range you describe using an array...
slightly updated to meet the integer requirement.
Sub sortStuff()
Const addr As String = "A1:A6"
Dim WS As Worksheet: Set WS = ActiveSheet 'or whatever the sheet ID name is
Dim sRNG As Range: Set sRNG = WS.Range(addr)
'changed this from first answer to integer requirement and optimize code
ReDim aRay(1 To sRNG.Rows.Count, 1 To sRNG.Columns.Count) As Integer
Dim x As Long, y As Long
For x = LBound(aRay, 1) To UBound(aRay, 1)
For y = LBound(aRay, 2) To UBound(aRay, 2)
aRay(x, y) = Application.WorksheetFunction.Large(sRNG.Columns(y), x)
Next y
Next x
'Puts into excel
sRNG = aRay
End Sub
Pretty basic question here but my VBA skills are pretty rusty. I have two worksheets where a machine just dumps data into them. Each sheet is just one column and SheetA has ~250 rows and SheetB has ~1300 rows. So what I need to do is compare the first value in sheetA to every value in sheetB, if a match is found I need to copy it to another sheet (SheetC) and then move to the next value in SheetA and repeat this till every value in SheetA has been compared to every value in SheetB. I think the best way to do this is with arrays but I cannot for the life of me remember how to do the actual comparison. Below is the code calling up the sheets and arrays I think....any help is appreciated!
Dim SheetA As Variant
Dim SheetB As Variant
Dim RangeToCheckA As String
Dim RangeToCheckB As String
'Get the worksheets from the workbooks
Set wbkA = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\OSM37 with locations 9-30-19.xls")
Set SheetA = wbkA.Worksheets("OSM37")
Set wbkB = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\New folder\Flat Rock and Roush VIN Tracker U625 - U611 Lower control arm welds.xlsx")
Set SheetB = wbkB.Worksheets("Master VIN")
'This is the range in SheetA
RangeToCheckA = "B2:B239"
'This is the range in SheetB
RangeToCheckB = "B4:B1339"
SheetA = SheetA.Range(RangeToCheckA)
SheetB = SheetB.Range(RangeToCheckB)
Without changing much of your code and adding a call to a custom function, you could do the following:
Private Sub CompareWorkBooks()
Dim wbkA As Workbook, wbkB As Workbook
Dim SheetA As Worksheet, SheetB As Worksheet, SheetC As Worksheet
Dim RangeToCheckA As String
Dim RangeToCheckB As String
Dim arrySheetA() As Variant, arrySheetB() As Variant, _
arryOut() As Variant
'Get the worksheets from the workbooks
Set wbkA = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\OSM37 with locations 9-30-19.xls")
Set SheetA = wbkA.Worksheets("OSM37")
Set wbkB = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\New folder\Flat Rock and Roush VIN Tracker U625 - U611 Lower control arm welds.xlsx")
Set SheetB = wbkB.Worksheets("Master VIN")
'This is the range in SheetA
RangeToCheckA = "B2:B239"
'This is the range in SheetB
RangeToCheckB = "B4:B1339"
'Value 2 is faster as it doesn't copy formatting
arrySheetA() = SheetA.Range(RangeToCheckA).Value2
arrySheetB() = SheetB.Range(RangeToCheckB).Value2
Set SheetC = wbkB.Worksheets("Sheet C")
arryOut() = FastLookUp(arrySheetA, arrySheetB, 1, 1, 1)
SheetC.Range("A1").Resize(UBound(arryOut, 1), _
UBound(arryOut, 2)).Value = arryOut
End Sub
FastLookUp Function:
Private Function FastLookUp(ByRef arryLookUpVals As Variant, ByRef arryLookUpTable As Variant, _
ByVal lngLookUpValCol As Long, ByVal lngSearchCol As Long, _
ByVal lngReturnCol As Long, _
Optional ByVal boolBinaryCompare As Boolean = True) As Variant
Dim i As Long
Dim dictLooUpTblData As Object
Dim varKey As Variant
Dim arryOut() As Variant
Set dictLooUpTblData = CreateObject("Scripting.Dictionary")
If boolBinaryCompare Then
dictLooUpTblData.CompareMode = vbBinaryCompare
Else
dictLooUpTblData.CompareMode = vbTextCompare
End If
'add lookup table's lookup column to
'dictionary
For i = LBound(arryLookUpTable, 1) To UBound(arryLookUpTable, 1)
varKey = Trim(arryLookUpTable(i, lngSearchCol))
If Not dictLooUpTblData.Exists(varKey) Then
'this is called a silent add with is faster
'than the standard dictionary.Add Key,Item
'method
dictLooUpTblData(varKey) = arryLookUpTable(i, lngReturnCol)
End If
varKey = Empty
Next i
i = 0: varKey = Empty
ReDim arryOut(1 To UBound(arryLookUpVals, 1), 1 To 1)
For i = LBound(arryLookUpVals, 1) To UBound(arryLookUpVals, 1)
varKey = Trim(arryLookUpVals(i, lngLookUpValCol))
'if the lookup value exists in the dictionary
'at this index of the array, then return
'its correspoding item
If dictLooUpTblData.Exists(varKey) Then
arryOut(i, 1) = dictLooUpTblData.Item(varKey)
End If
varKey = Empty
Next i
FastLookUp = arryOut
End Function
FastLookup functions exactly like a VLOOKUP, but is a bit more flexible, because the the lookup column does not have to be the first one in the range you are looking up, as you are allowed to specify which column by providing a value for lngLookUpValCol parameter.
Concerning that you have 3 worksheets in 1 workbook - Worksheets(1) and Worksheets(2) are the one, in which the values in Range("A1:A7") and Range("A1:A3") are compared:
Sub TestMe()
Dim arrA As Variant
Dim arrB As Variant
With Application
arrA = .Transpose(Worksheets(1).Range("A1:A7"))
arrB = .Transpose(Worksheets(2).Range("A1:A3"))
End With
Dim a As Variant
Dim b As Variant
For Each a In arrA
For Each b In arrB
If a = b Then
Worksheets(3).Cells(1 + LastRow(Worksheets(3).Name), 1) = b
End If
Next
Next
End Sub
Function LastRow(wsName As String, Optional columnToCheck As Long = 1) As Long
Dim ws As Worksheet
Set ws = Worksheets(wsName)
LastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row
End Function
If you are planning to use the code above, it is a good idea to make sure that the values in Worksheets(1) are all unique, otherwise the code would repeat them N times. Or add a dictionary, to exclude repeated values.
So I have a worksheet with a bunch of linked cells set to a UNC path. For example, lets say that Cell A1 is equal to:
='\\corp\StackOverflow\[Example01.xlsx]TestSheet'!$A$1
and Cell A2 is equal to:
='\\corp\StackOverflow\[Example02.xlsx]TestSheet'!$A$1
Is there a way to have a CountIf for a partial string of "StackOverflow" for the entire worksheet? It would return a 2.
Sub Search()
Dim r As Range, s As String, i As Long
Dim ws As Worksheet
s = "StackOverflow"
For Each ws In ActiveWorkbook.Worksheets
Set r = ws.Cells
i = Application.WorksheetFunction.CountIf(r, "*" & s & "*")
MsgBox ("i: " & i)
Next ws
End Sub
This is what I am using, but it always returns a 0 because I think it only looks at the Values. I want it to look inside of the formula (even if that cell normally returns a #REF! error). And yes, if it could look at the entire worksheet's cells, because I want to use it on a For Each ws basis.
One can search the text of formula cells for a specific string and increase the counter.
Sub Search()
Dim r As Range, s As String, i As Long
Dim ws As Worksheet
s = lcase("StackOverflow")
For Each ws In ActiveWorkbook.Worksheets
For Each rng In ws.Cells.SpecialCells(xlCellTypeFormulas)
If LCase(rng.Formula) Like "*" & s & "*" Then i = i + 1
Next
Next ws
MsgBox ("i: " & i)
End Sub
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)