I have a named cell, and I want to start searching values from this row, but from the previous column.
This is the code I have:
'I use the "false false" for not having an absolute reference, I don't know if this will have any impact later ?
newAdres = SearchForTotal(Range("total1").Address(False, False))
And this is the function itself:
Function SearchForTotal(givenLocation As Variant) As Variant
Debug.Print givenLocation
Debug.Print Range(givenLocation).Offset(, -1)
The first debug gives me: "U84", the second gives me: "0" , while I would like to have T84 instead
Don't give your function an address/string give the function the cell/range. Variant is the worst type you can use in VBA.
Function SearchForTotal(ByVal givenLocation As Range) As Range
Debug.Print givenLocation.Address
Debug.Print givenLocation.Offset(0, 1).Address
' return the offset cell
Set SearchForTotal = givenLocation.Offset(0, 1)
End Function
Then call your function like
Dim NewCell As Range
Set NewCell = SearchForTotal(Range("total1"))
Debug.Print NewCell.Address
Always work with ranges/cells and use addresses/strings only for displaying purpose.
Related
I am using the following Index Match function to get the name of a company where the spend data matches that of which I type into cell BF17.
=INDEX($AM$16:$BB$16,MATCH(BF17,AM17:BB17,0))
What I want to be able to do is list multiple results within the same cell and separate these with a comma.
Does anyone know if this is possible and if so can someone please show me how?
Thanks
Code:
Insert this code in a module in your workbook:
Public Function hLookupList(KeyVal, Vals As Range, Ret As Range) As String
Dim i As Long
Dim vw As Worksheet
Dim rw As Worksheet
Dim RetStr As String
Application.Volatile True
Set vw = Vals.Worksheet
Set rw = Ret.Worksheet
If Vals.Rows.Count > 1 Then
hLookupList = "Too Many Value Rows Selected!"
Exit Function
End If
If Ret.Rows.Count > 1 Then
hLookupList = "Too Many Return Rows Selected!"
Exit Function
End If
If Vals.Columns.Count <> Ret.Columns.Count Then
hLookupList = "Value Range and Return Range must be the same size!"
Exit Function
End If
For i = Vals.Column To Vals.Column + Vals.Columns.Count - 1
If vw.Cells(Vals.Row, i) = KeyVal Then
RetStr = RetStr & rw.Cells(Ret.Row, Ret.Column + i - 1) & ", "
End If
Next i
hLookupList = Left(RetStr, Len(RetStr) - 2)
End Function
Then:
Insert this in the cell where you want your list: =hLookupList(BF17, $AM$16:$BB$16, $AM$17:$BB$17)
Unfortunately there is no built-in way to make a vlookup or index/match function return an array. You could do it with a custom formula or if you know there are a limited number of results, a few nested lookups. Lewiy at mrexcel.com wrote a great custom function that I use, which can be found here. This function can be slow if you are looking up a large number of rows.
Since you are looking up columns and want commas separating the results instead of spaces, you will need to modify the code as follows:
Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long)
Dim r As Range
Dim result As String
result = ""
For Each r In lookuprange
If r = lookupval Then
result = result & "," & r.offSet(indexcol, 0)
End If
Next r
result = Right(result, Len(result) - 1)
MYVLOOKUP = result
End Function
Your formula would then be =MYVLOOKUP(BF17,AM17:BB17,-1)
If you want a space after the comma (in the results), change:
result = result & "," & r.offSet(indexcol, 0)
to
result = result & ", " & r.offSet(indexcol, 0)
If you haven't used custom functions before, hit Alt + F11 when in Excel to bring up the VBE, and add a new module to the workbook you are working on (Insert --> Module). Just copy and paste this code in there. I would recommend Paste Special --> Values before sending the workbook to anyone. Let me know if you have any questions implementing it!
Here is my code
Function copyToNewRange(a As Range, b As Range)
' a is input, b is output
If a.Cells.Count <> b.Cells.Count Then
copyToNewRange = "ERROR"
Exit Function
End If
For i = 1 To a.Cells.Count
b.Cells(i, 1) = a.Cells(i, 1)
Next i
copyToNewRange = "COPIED"
End Function
I would use it thus:
=copyToNewRange(A11:A30,C11:C30)
in a cell not in the input or output range!
Why do I get #VALUE!?
I note that commenting out b.Cells(i, 1) = a.Cells(i, 1) allows it to run, but what is the error in this line?
A UDF (a user defined function, called from a worksheet) cannot directly modify other cells, it can only return a value. There are, however, workarounds.
One such workaround is to construct a call to a Sub as a string, and use Evaluate to execute it.
Something like this:
Function copyToNewRange(rSrc As Range, rDst As Range)
Dim sSub As String
If rSrc.Columns.Count > 1 Or rDst.Columns.Count > 1 Then
copyToNewRange = CVErr(xlErrValue)
ElseIf rSrc.Rows.Count <> rDst.Rows.Count Then
copyToNewRange = CVErr(xlErrValue)
Else
sSub = "copyToNewRangeSub(" & _
rSrc.Address(True, True, xlA1, True) & "," & _
rDst.Address(True, True, xlA1, True) & ")"
rSrc.Worksheet.Evaluate sSub
copyToNewRange = vbNullString
End If
End Function
Sub copyToNewRangeSub(rSrc As Range, rDst As Range)
rDst.Value = rSrc.Value
End Sub
Note, there are several other issues in your code I have addressed
When you want your function to return an err, return an ... Error
To ensure the ranges are shaped correctly, counting cells alone is not enough
Don't loop over a range, copy it in one go.
Your function should return something
You should Dim all your variables (use Option Explicit to force this)
Use meaningfull parameter names
Thanks to Tim Willaims for the concept
In a worksheet, you can't use a function that DOES things. Only one that returns data. That is quite logical, since the function is evaluated every time the sheet changes.
If you really want that behaviour, use the Worksheet_Change event.
Also note that, in your example, it is very uneffective to copy cells 1 by 1, compared to copy a range at once.
I am a quite new to Excel VBA, and I come from a more... traditional programming background (Java, C). I am having issues with passing a Range Object as a parameter in my User-defined function (see below). The idea of my function is to take several parameters to complete a VLOOKUP of a filtered range.
I may have several syntax issues (I am unsure of my return type and my usage of VLOOKUP), and I would appreciate some guidance on this. See results, more information in my code:
Public Function GETVALUE(screen As String, strEvent As String, dataRange As Range, strDate As String) As String
'ASSUMPTION: dataRange has three columns; first column contains lookup values; Second
' column contains dates for filtering; Third column contains return values
Dim result As String
'remove irrelevant dates in dataRange; apply filter
'ASSUMPTION: This process should return a Range that is removes all Rows that does
'not have strDate in the second column
Dim newRange As Range
'RESULT: Returns #VALUE!. I know this is not the typical := syntax I see in many
'examples but this one apparently compiles, so I use it. I comment this line out
'and try to make the other lines below work with dummy parameters or fixed ranges
newRange = dataRange.AutoFilter(2, strDate)
'Now I try to use the newly filtered, "newRange" and use that in my VLOOKUP
'and return it.
result = [VLOOKUP("*" & screen & "/" & strEvent & "*", newRange, 3, False)]
'I can see an Error 2029 here on Result
GETVALUE = result
'RESULT: Returns #VALUE!
End Function
VLOOKUP ignores any filtering of your data. In other words VLOOKUP will also look in the hidden rows.
I would suggest two alternative approaches:
Copy the visible cells of the filtered range to a new sheet and perform the lookup there:
Set newRange = dataRange.AutoFilter(2, strDate).SpecialCells(xlCellTypeVisible)
set ws = worksheets.Add
ws.Range("A1").Resize(newRange.Rows.Count,newRange.Columns.Count).Value = newRange.Value
etc.
Note that this can not be done in a UDF, you would have to do it in a a Sub.
Store the values in dataRange in a variant array and loop to search for the required value:
Dim arr() as Variant
arr = dataRange.Value
For i = LBound(arr,1) to UBound(arr,1)
If (arr(i,2) = strDate) And (arr(i,1) LIKE "*" & screen & "/" & strEvent & "*"( Then
GETVALUE = arr(i,3)
Exit Function
End If
Next
This I think causes your problem:
result = [VLOOKUP("*" & screen & "/" & strEvent & "*", newRange, 3, False)]
Replace it with this instead:
result = Evaluate("VLOOKUP(*" & screen & "/" & strEvent _
& "*, " & newRange.Address & ", 3, False)")
[] which is shortcut for Evaluate doesn't work on variables.
If it is a direct VLOOKUP like below:
result = [VLOOKUP(D1,Sheet1!$A:$C,3,FALSE)]
it will work. But if you are working with variables as in your example, you have to explicitly state it.
And take note that Evaluate accepts Name argument in a form of string.
So you simply have to concatenate all your strings and then explicitly use Evaluate.
Edit1: Additional Inputs
This will not work as well: newRange = dataRange.AutoFilter(2, strDate).
To pass Objects to a Variable you need to use Set like this.
Set newrange = dataRange.AutoFilter(2, strDate)
On the other hand, AutoFilter method although returning a Range Object fails.
I'm not entirely sure if this can't really be done.
Moving forward, to make your code work, I guess you have to write it this way:
Edit2: Function procedures only returns values, not execute methods
Public Function GETVALUE(screen As String, strEvent As String, rng As Range)
GETVALUE = Evaluate("VLOOKUP(*" & screen & "/" & strEvent & "*, " _
& rng.Address & ", 3, False)")
End Function
To get what you want, use above function in a Sub Procedure.
Sub Test()
Dim dataRange As Range, strDate As String, myresult As String
Set dataRange = Sheet2.Range("A2:E65") 'Assuming Sheet2 as property name.
strDate = "WhateverDateString"
dataRange.AutoFilter 2, strDate
myresult = GETVALUE("String1", "String2", dataRange)
End Sub
Btw, for a faster and less complex way of doing this, try what Portland posted.
Basically you must write :
Getvalue = Application.VLookup( StringVar, RangeVar, ColumnNumberVar)
Vlookup needs your data to be previously ordered in alphabetical order, or it doesn't work.
Excel Developers's approach is a good one too, using a VBA Array.
I can also point the VBA functions FIND, and MATCH, wich will get you the row of searched data, and then you can pull what you need from the 3rd column of that row.
Wichever is faster depends of the size of your range.
I am trying to make a simple sum function that sums until I hit a blank cell. I am not sure why it is not working. I am trying to sum currency and have the output be a currency as well. So far I have:
Function SumContin(X)
Dim Ro As Long
Dim Col As Long
Dim Ro1 As Long
Dim Col1 As Long
Ro = Application.WorksheetFunction.Row(X)
Col = Application.WorksheetFunction.Column(X)
Do While Cells(Ro, Col) <> ""
Sum = Sum + CInt(Cells(Ro, Col))
Ro = Ro - 1
Loop
End Function
UPD:
Follow up from comments:
Can I make the function where it will be =SumContin() and it starts from the cell above?
Function SumContin()
Application.Volatile
SumContin = 0
On Error Resume Next
With Application.ThisCell
If .Row = 1 Then Exit Function
If .Offset(-1) = "" Then Exit Function
SumContin = Application.Sum(Range(.Offset(-1), .End(xlUp)))
End With
End Function
Note: since code using Application.ThisCell, function will work only in case when you call it from worksheet: =SumContin() and won't work if you call it from any code
A UDF for this seems overkill given that in the A provided the requisite range has to be keyed in anyway. A running total something like =SUM(A$1:A1) and double-clicking on the fill handle may be more convenient at times.
It would be most efficient to just define the range withing the UDF based on the cell passed, and then use the WorksheetFunction.Sum command.
Here's one way:
Function SumContin(X As Range)
SumContin = WorksheetFunction.Sum(Range(X.Address & ":" & X.End(xlDown).Address))
End Function
I use check boxes on individual worksheets to set ranges for performing VLookup functions. One of the check boxes needs to set two distinct ranges in which to search. I'm out of ideas on how to make this work. All the other possible variants are searching a continuous string of cells (i.e. [S9:T20] or [S55:T66] but not both. If I end up having to u multiple variables and perform the function twice the rest of my code will probably not work. Any ideas would be appreciated including if some sort of Find function might do similar work.
Below are snippets of the code that I use:
Dim rngO As Variant
ElseIf ActiveSheet.Shapes("Check Box 43").ControlFormat.Value = 1 Then
rngO = [S9:T20;S55:T66]
The rngO variant is used as shown below (one example):
Case 2
With ActiveSheet
.Range("U2").Value = "1Y"
.Range("V2").Value = WorksheetFunction.VLookup("1Y", rngO, 2, False)
.Range("U3").Value = "1P"
.Range("V3").Value = WorksheetFunction.VLookup("1P", rngO, 2, False)
.Range("U4").Value = "."
.Range("V4").Value = "."
short answer: Yes - it is!
longer answer:
You wrap the WorksheetFunction.VLookup() by some code looking at each area of your source range individually.
Function MyVLookup(Arg As Variant, Source As Range, ColNum As Integer, Optional CmpSwitch As Boolean = True) As Variant
Dim Idx As Integer
MyVLookup = CVErr(xlErrNA) ' default return value if nothing found
On Error Resume Next ' trap 1004 error if Arg is not found
For Idx = 1 To Source.Areas.Count
MyVLookup = WorksheetFunction.VLookup(Arg, Source.Areas(Idx), ColNum, CmpSwitch)
If Not IsError(MyVLookup) Then Exit For ' stop after 1st match
Next Idx
End Function
and in your original code replace all calls to WorksheetFunction.VLookup() by calls to MyVLookup() with the same parameters.
Alternatively you can use this function directly in a cell formula (that's what I usually do with it ...)