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.
Related
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.
This is a segment of code that has been troubling me, as I feel certain some simple function exists that will make looping through the array values redundant.
Instead I have used an array, a loop and a boolean to tell me whether the cells are empty (or test their length) and an If statement to run the last part of the code.
I thought perhaps Max would work but I believe that is only for integers. (See the debug.print part
Dim arrArchLoc As Variant
Dim boolArchLoc As Boolean
Dim rowCounter As Long
boolArchLocEmpty = False
arrArchLoc = ActiveSheet.Range(Cells(2, colArchiveLocation), Cells(lastRow, colArchiveLocation))
For rowCounter = LBound(arrArchLoc) To UBound(arrArchLoc)
If Cells(rowCounter, colArchiveLocation) <> "" Then boolArchLocEmpty = True
Next rowCounter
'Debug.Print workshetfunction.Max(arrArchLoc)
If boolArchLocEmpty = True Then
ActiveSheet.Cells(1, colArchiveLocation).Value = "Arch Loc"
Columns(colArchiveLocation).ColumnWidth = 6
End If
Does such a function or simple method exist?
EDIT:
Whilst that specialcells(xlCellTypeBlanks) solution looks pretty good, I would still rather get the string length solution.
My apologies, the code initially had something like...
If len(Cells(rowCounter, colArchiveLocation)) > 6 then...
but I have since removed it after having to get something in place that would work.
Is there something I could do with LEN(MAX)? I experimented with it but didn't get very far.
Given the range is A2:A100, the result you want would be expressed on the sheet as an array formula:
={MAX(LEN(A2:A100))}
In order to execute that from VBA as an array formula and not a regular formula, you need to use Evaluate:
max_len = Evaluate("=MAX(LEN(A2:A100))")
Or, in terms of your code,
Dim arrArchLoc As Range
With ActiveSheet
Set arrArchLoc = .Range(.Cells(2, colArchiveLocation), .Cells(lastRow, colArchiveLocation))
End With
Dim max_len As Long
max_len = Application.Evaluate("=MAX(LEN(" & arrArchLoc.Address(external:=True) & "))")
However it is much better to calculate it explicitly with a loop, like you were already doing.
Why not something like so
activesheet.range(cells(1,1),cells(10,1)).specialcells(xlCellTypeBlanks)
Another way to check if the range is empty or not
Sub Sample()
Debug.Print DoesRangeHaveEmptyCell(Range("A1:A10")) '<~~ Change as applicable
End Sub
Function DoesRangeHaveEmptyCell(rng As Range) As Boolean
If rng.Cells.Count = Application.WorksheetFunction.CountA(rng) Then _
DoesRangeHaveEmptyCell = False Else DoesRangeHaveEmptyCell = True
End Function
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!
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 ...)