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 ...)
Related
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 have two files one is a Project Register that holds key information on a project and the other is a Risk log.
There is a 1:m relationship between entries in the Register and the Risk log. What I need to do is combine all of a project risks into one cell inside the project register file.
The matching field in both files is the Project ID field
Is there a way I can do this using a vlookup variant or multiple nested vlookups?
Here's the user-defined function approach I mentioned (adapted from a different VLOOKUP-variant I already had made):
' Acts like VLOOKUP in a 1-to-many scenario by concatenating all values in matching rows
' instead of just returning the first match
Public Function VLOOKUP_MANY(lookup_value As String, lookup_range As Range, column_number As Integer, Optional delimiter As Variant) As Variant
Dim vArr As Variant
Dim i As Long
Dim found As Boolean: found = False
' Set default delimiter
If IsMissing(delimiter) Then delimiter = ", "
' Get values
vArr = lookup_range.Value2
' If column_number is outside of the specified range, return #REF
If column_number < LBound(vArr, 2) Or column_number > UBound(vArr, 2) Then
VLOOKUP_MANY = CVErr(xlErrRef)
Exit Function
End If
' Search for matches and build a concatenated list
VLOOKUP_MANY = ""
For i = 1 To UBound(vArr, 1)
If UCase(vArr(i, 1)) = UCase(lookup_value) Then
VLOOKUP_MANY = VLOOKUP_MANY & delimiter & vArr(i, column_number)
found = True ' Mark at least 1 result
End If
Next
If found Then
VLOOKUP_MANY = Right(VLOOKUP_MANY, Len(VLOOKUP_MANY) - Len(delimiter)) ' Remove first delimiter
Else
VLOOKUP_MANY = CVErr(xlErrNA) ' If no matches found, return #N/A
End If
End Function
This will search the first column in the specified range for the specified value (same as VLOOKUP), but returns the values in the specified column number concatenated. It will return #N/A when no matches are found, and #REF if an invalid value is specified for the column number (e.g. you choose column 5 but only had a 4-column table).
In case you don't know about user-defined functions - you can just copy this VBA code into the VBE for a module in your workbook. Hit Alt+F11, go to Insert > Module at the top of the screen, then paste this code into the blank file that opens up. When you go to save, you'll have to save your workbook as Macro-Enabled (.xlsm) to keep the code working - Excel will remind you about this in the save screen.
Be forewarned: it's going to be slower than VLOOKUP as a result of having to look through the entire lookup range instead of being able to stop at the first match it finds.
If you're open to using an array formula instead, there are ways to speed up this sort of functionality for very large datasets...
Different version that leverages some of the benefits of array formulas to store lookup values and speedup subsequent calls:
' Acts like VLOOKUP in a 1-to-many scenario by concatenating all values in matching rows
' instead of just returning the first match
' Utilizes a dictionary to speedup multiple matches (great for array formulas)
Public Function VLOOKUP_MANY_ARRAY(lookup_values As Range, lookup_range As Range, column_number As Integer, Optional delimiter As Variant) As Variant
Dim vHaystack As Variant, vNeedles As Variant
Dim i As Long
Dim found As Boolean: found = False
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
' Set default delimiter
If IsMissing(delimiter) Then delimiter = ", "
' Get values
vHaystack = lookup_range
vNeedles = lookup_values
' If column_number is outside of the specified range, return #REF
If column_number < LBound(vHaystack, 2) Or column_number > UBound(vHaystack, 2) Then
VLOOKUP_MANY_ARRAY = CVErr(xlErrRef)
Exit Function
End If
' Add values to a lookup dictionary
For i = 1 To UBound(vHaystack, 1)
If dict.Exists(UCase(vHaystack(i, 1))) Then
dict.Item(UCase(vHaystack(i, 1))) = dict.Item(UCase(vHaystack(i, 1))) & delimiter & vHaystack(i, column_number)
Else
dict.Add UCase(vHaystack(i, 1)), vHaystack(i, column_number)
End If
Next
Dim outArr As Variant
If IsArray(vNeedles) Then ' Check number of lookup cells
' Build output array
ReDim outArr(1 To UBound(vNeedles, 1), 1 To 1) As Variant
For i = 1 To UBound(vNeedles, 1)
If dict.Exists(UCase(vNeedles(i, 1))) Then
outArr(i, 1) = dict.Item(UCase(vNeedles(i, 1)))
Else
outArr(i, 1) = CVErr(xlErrNA)
End If
Next
Else
' Single output value
If dict.Exists(UCase(vNeedles)) Then
outArr = dict.Item(UCase(vNeedles))
Else
outArr = CVErr(xlErrNA)
End If
End If
VLOOKUP_MANY_ARRAY = outArr
End Function
This creates a Dictionary, which is a special structure that's really good for looking up values. There's a little extra overhead involved in building it, but once you have the structure, you can do lookups into it very quickly. This is especially nice with array formulas, which is basically when the exact same formula gets put into a whole collection of cells, then the function executes once and returns values for every cell (instead of just executing once, separately, for a bunch of cells). Enter it like an array formula with CTRL+SHIFT+ENTER, and make the first argument refer to all your lookup values instead of just one.
It will work without being used as an array formula, but it will be somewhat slower than the first function in that situation. However, if you use it in an array formula, you'll see huge speedups.
RE-EDIT:
You might need to write a user defined function or write a macro (code on same link)
I'm looking for a simple Excel VBA or formula that can convert an entire row in Excel from 'number stored as Text' to an actual Number for vlookup reasons.
Can anyone point me in the right direction?
Better Approach
You should use INDEX(MATCH) instead of VLOOKUP because VLOOKUP behaves in an unpredictable manner which causes errors, such as the one you're presumably experiencing.
INDEX ( <return array> , MATCH ( <lookup value> , <lookup array> , 0) )
Using 0 as the last argument to MATCH means the match must be exact
Here is some more in-depth information on INDEX(MATCH)-ing
Further
Add zero +0 to convert a value to a number.
This can be (dangerously) extended with IFERROR() to turn non-numeric text into a zero:
=A2+0
=IFERROR(A2+0,0)
For the inverse, you can catenate an empty string &"" to force the value to be a string.
Notes
If 0 is not used as the last argument to MATCH, it will find all sorts of unexpected "matches" .. and worse, it may find a different value even when an exact match is present.
It often makes sense to do some extra work to determine if there are duplicates in the MATCH lookup column, otherwise the first value found will be returned (see example).
Help with MATCH comes from here, notably the matching logic the 3rd argument controls.
This should work if you add it before your vlookup or index/match lines:
Sheets("Sheet1").UsedRange.Value = Sheets("Sheet1").UsedRange.Value
I did find this, but does anyone have a formula as well?
Sub macro()
Range("F:F").Select 'specify the range which suits your purpose
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
End Sub
http://www.ozgrid.com/forum/showthread.php?t=64027
Try this:
Sub ConvertToNumber()
Application.ScreenUpdating = False
Dim cl As Range
For Each cl In Selection.Cells
cl.Value = CInt(cl.Value)
Next cl
Application.ScreenUpdating = True
End Sub
To use it, simply select the relevant block of cells with the mouse, and then run the macro (Alt+F8 to bring up the dialogue box). It will go through each cell in the selected range and convert whatever value it holds into a number.
I wrote a custom vlookup function that doesn't care about data formats. Put this into a module in VBA and use = VLOOK instead of = VLOOKUP
Public Function VLook(sValue As String, rDest As Range, iColNo As Integer)
' custom vlookup that's insensitive to data formats
Dim iLastRow As Long
Dim wsDest As Worksheet
Set wsDest = Sheets(rDest.Parent.Name)
iLastRow = wsDest.Range(wsDest.Cells(100000, rDest.Column).Address).End(xlUp).Row
If iLastRow < rDest.Row + rDest.Rows.Count Then
For X = rDest.Column To rDest.Column + rDest.Columns.Count
If wsDest.Cells(100000, X).End(xlUp).Row > iLastRow Then iLastRow = wsDest.Cells(100000, X).End(xlUp).Row
Next X
End If
sValue = UCase(Application.Clean(Trim(sValue)))
For X = rDest.Row To iLastRow
If UCase(Application.Clean(Trim(wsDest.Cells(X, rDest.Column)))) = sValue Then
VLookDM = wsDest.Cells(X, rDest.Column + iColNo - 1)
Exit For
End If
Next X
End Function
The easiest way I can think of is using the built-in function =VALUE(TEXT_TO_CONVERT_TO_STRING).
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 have a problem. I spent hours designing a form which works just great with all your feedback. Today, everything went wrong. The reason for this is simple. A few new columns got added and, obviously, the data my form is reading in is now wrong.
Thus I was thinking of trying the following...
Rather than using the column number as below
TK = Cells(ActiveCell.Row, "S").Value 'everything in the form refers to the active row
I could possibly use the column headings in Row 1.
Is that possible ? This way the spreadsheet can have columns added up to as many as a user would like and the form would dynamically scan for the right heading and get the column number that way.
My thought is, on opening the form, read in all the headings, pick out the ones I need and assign them to a variable. Then I use my normal code and substitute the variable into the column section.
It sounds easy, but I have no idea how to do this.
Use the versatile Find to give you a quick method of detecting where your header is - or if it is missing
Find details here
In the code below I have specified that the search must return
an exact match (xlWhole)
a case sensitive match (False)
The match can be a partial match (xlPart) if you were looking to match say Game out of Game X
code
Const strFind = "Game"
Sub GetEm()
Dim rng1 As Range
Set rng1 = ActiveSheet.Rows(1).Find(strFind, , xlValues, xlWhole, , , False)
If Not rng1 Is Nothing Then
MsgBox "Your column is " & rng1.Column
Else
MsgBox strFind & " not found", vbCritical
End If
End Sub
Why use a loop? There's no need to.
Dim col as variant
Col = application.match("my header", rows(1), 0)
If iserror(col) then
'not found
Else
TK = cells(activecell.row, col)
End if
For this purpose I usually use a function which runs through the headers (in the first row of a sheet) and returns the number of the column which contains the value I have searched for.
Public Function FindColumn(HeaderName As String, Sht As String) As Long
Dim ColFound As Boolean
Dim StartingPoint As Range
ColFound = False
Set StartingPoint = Sheets(Sht).Range("A1")
Do While StartingPoint.Value <> ""
If UCase(Trim(StartingPoint.Value)) = UCase(Trim(HeaderName)) Then
FindColumn = StartingPoint.Column
ColFound = True
Exit Do
Else
Set StartingPoint = StartingPoint.Offset(0, 1)
End If
Loop
If Not ColFound Then FindColumn = 0
End Function
Example:
If the first row of your sheet named "Timeline" contains headers like e.g. "Date" (A1), "Time" (B1), "Value" (C1) then calling FindColumn("Time", "Timeline") returns 2, since "Time" is the second column in sheet "Timeline"
Hope this may help you a little.
Your thought is a good one. Reading in column headers to calculate addresses is one way to avoid hard coding - e.g.
Sub Test()
Dim R As Range
Set R = ActiveSheet.[A1]
Debug.Print ColNo(R, "Col1Hdr")
End Sub
Function ColNo(HdrRange As Range, ColName As String) As Integer
' 1st column with empty header is returned if string not found
ColNo = 1
Do While HdrRange(1, ColNo) <> ""
If HdrRange(1, ColNo) = ColName Then Exit Do
ColNo = ColNo + 1
Loop
End Function
Another way I frequently use - and I must admit I prefer it over the above, is to define Enum's for all my tables in a seperate "definition" module, e.g.
Public Enum T_VPN ' sheet VPN
NofHRows = 3 ' number of header rows
NofCols = 35 ' number of columns
MaxData = 203 ' last row validated
GroupNo = 1
CtyCode = 2
Country = 3
MRegion = 4
PRegion = 5
City = 6
SiteType = 7
' ....
End Enum
and use it like
Sub Test1()
Debug.Print ActiveSheet(T_VPN.NofHRows, T_VPN.Country)
End Sub
As you can see, the usage is simpler. Allthough this is again "some kind" of hardcoding, having all definition in one place reduces maintenance significantly.