I don't know if I explained this too well. I'm a beginner and I'm trying to get a value from a file using VLOOKUP in VBA. However, even though I can apparently work with the string itself, I cannot use it as a variable.
So, the idea is to automatically populate two text boxes when I select something in the dropdown. The dropwdown itself determines the Worksheet that has the data.
Private Sub cbProductList1_Change()
vCode1 = Application.WorksheetFunction.VLookup(cbProductList1.Value,
[Products!A:B], 2, False)
Me.tbProdCode1 = vCode1
vPrice1 = Evaluate("VLOOKUP(" & vCode1 & ", " & Me.labelCFValue & ", 2, False)")
Me.tbPrice1 = vPrice1
End Sub
If I run a MsgBox on vCode1 - it gives me the string that needs to be the first argument for VLOOKUP.
If I run a MsgBox on Me.labelCFValue it gives me CF_1!A25:B33 (without the quotes) just as I need it to do. But when I run MsgBox on vPrice1, I get an error.
Later Edit: Alternatively, if you could help me use Me.labelCFValue inside Application.WorksheetFunction.VLookup(), that could also be good.
Please help?
I was unable to test the code but believe that this should either work or help you find your way.
Option Explicit
Private Sub cbProductList1_Change()
Dim Rl As Long ' last row
Dim LookupRange As Range
Dim Sp() As String ' splitting labelCFValue
Dim vCode1 As String
Dim vPrice1 As Double
' ActiveSheet is the default, but better to declare
With ActiveSheet
Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
Set LookupRange = .Range(.Cells(1, 1), Cells(Rl, 2))
End With
vCode1 = Application.VLookup(cbProductList1.Value, LookupRange, 2, False)
Me.tbProdCode1 = vCode1
' If Me.labelCFValue is a Label, the string should be its Caption property.
' If it is a Textbox the string should be its Value or Text property.
' Either way, it is better to specify what you are addressing:-
Sp = Split(Me.labelCFValue, "!")
Set LookupRange = Worksheets(Sp(0)).Range(Sp(1))
vPrice1 = Evaluate(Application.VLookup(vCode1, LookupRange, 2, False))
Me.tbPrice1 = vPrice1
End Sub
Consider adding some precautionary code to deal with the possibility that either of the Vlookups return an error.
Related
I've seen how to edit a hyperlink - but I need to add a hyperlink when used as a custom formula.
I get a #VALUE error and I'm not sure why. Does anyone have any ideas why I get a #VALUE error when I try to use it in a sheet as =testit39()
Public Function testit39() As String
Application.Volatile
Dim rng As range, milestoneinfo As String, milestonesymbol As String
Set rng = Application.Caller
milestoneinfo = "info"
milestonesymbol = "symbol"
If rng.Hyperlinks.Count > 0 Then
rng.Hyperlinks(1).address = ""
rng.Hyperlinks(1).screentip = milestoneinfo
Else
ThisWorkbook.ActiveSheet.Hyperlinks.Add Anchor:=rng, _
address:="", _
screentip:=milestoneinfo
rng.Hyperlinks(1).screentip = milestoneinfo
End If
testit39 = milestonesymbol
End Function
I have found a way that is not complicated thanks to this wonderful tutorial..
http://optionexplicitvba.blogspot.co.uk/2011/04/rollover-b8-ov1.html
So essentially you put it in a hyperlink and you're free to do as you please..
=hyperlink(testit39(), "Wahoo it works!")
UDFs (User-defined functions) are only allowed to return a value, they may not e.g. affect other cells or do other manipulations.
When you single-step through your code, you'll see that it aborts on the ...Hyperlinks.Add-line (and returns an error value).
Following VBA Sub code snippet allows adding new Hyperlink, or editing existing in a specified sample cell "A1" (non-essential part of your code has been removed for better clarity):
Public Sub AddOrEditHyperlink(milestonesymbol As String)
Dim rng As Range, milestoneinfo As String
'test range
Set rng = Range("A1")
'sample properties
milestoneinfo = "info"
'if Hyperlink exists, display "Edited"
If rng.Hyperlinks.Count > 0 Then
rng.Hyperlinks(1).Address = ""
rng.Hyperlinks(1).ScreenTip = milestoneinfo
rng.Hyperlinks(1).TextToDisplay = "Edited Hyperlink"
Else 'if Hyperlink does not exist, add and display "New"
rng.Hyperlinks.Add _
Anchor:=rng, _
Address:="", _
ScreenTip:=milestoneinfo, _
TextToDisplay:="New Hyperlink"
End If
End Sub
You can call this Sub from the Function that you can define (UDF) corresponding to the rest of business logic of your project (which is a bit unclear articulated):
Public Function testit39() As String
Application.Volatile
Dim rng As Range, milestoneinfo As String, milestonesymbol As String
Call AddOrEditHyperlink("some Symbol")
testit39 = milestonesymbol
End Function
Hope this will help. Best regards
I am writing a VBA formula to check that all characters in a cell "TestChars" are allowed, where allowed means that each character appears in a list defined by another cell "AllowedChars". To make things even harder, I would like this formula to work on ranges of cells rather than on a single cell.
The current code seems to work:
Option Explicit
Public Function AllCharsValid(InputCells As Range, AllowedChars As String) As Boolean
' Check that all characters in InputCells are among
' the characters in AllowedChars
Dim Char As String
Dim Index As Integer
Dim RangeTestChars As Range
Dim TestChars As String
For Each RangeTestChars In InputCells
TestChars = RangeTestChars.Value
For Index = 1 To Len(TestChars)
Char = Mid(TestChars, Index, 1)
If InStr(AllowedChars, Char) = 0 Then
AllCharsValid = False
Exit Function
End If
Next Index
Next RangeTestChars
AllCharsValid = True
End Function
I have the following questions:
The formula takes a range and returns a single boolean. I would prefer a vectorized function, where, given an input range, you get a corresponding range of booleans. It seems like built-in formulas like 'EXACT' can do this (those formulas where you have to press ctrl-shift-enter to execute them and where you get curly-brackets). Is there a way to do that with user-defined functions?
I am not new to programming, however I am completely new to VBA (I started literally today). Is there any obvious problem, weirdness with the above code?
Are there special characters, extremely long texts or particular input values that would cause the formula to fail?
Is there an easier way to achieve the same effect? Is the code slow?
when you start typing built-in formulas in excel you get suggestions and auto-completion. This doesn't seem to work with my formula, am I asking for too much or is it possible to achieve this?
I realize that this question contains several weakly related sub-questions, so I would be very happy also with sub-answers.
The following code will return a range of boolean values offset one column from the initial input range. Simply create a new tab in Excel and run testAllCharsValid and show the Immediate window in the IDE to see how it works.
Sub testAllCharsValid()
Dim i As Integer
Dim cll As Range, rng As Range
Dim allowedChars As String
' insert test values in sheet: for testing purposes only
With ActiveSheet ' change to Thisworkbook.Sheets("NameOfYourSheet")
Set rng = .Range("A1:A10")
For i = 1 To 10
.Cells(i, 1) = Chr(i + 92)
Next i
End With
' fill allowedChars with letters a to z: for testing purposes only
For i = 97 To 122
allowedChars = allowedChars & Chr(i)
Next i
' get boolean range
Set rng = AllCharsValid(rng, allowedChars)
' check if the returned range contains the expected boolean values
i = 0
For Each cll In rng
i = i + 1
Debug.Print i & " boolean value: " & cll.Value
Next cll
End Sub
' Check that all characters in InputCells are among
' the characters in AllowedChars
Public Function AllCharsValid(InputCells As Range, allowedChars As String) As Range
Dim BoolTest As Boolean
Dim Char As String
Dim Index As Integer
Dim RangeTestChars As Range, RangeBooleans As Range, RangeTemp As Range
Dim TestChars As String
For Each RangeTestChars In InputCells
BoolTest = True
TestChars = RangeTestChars.Value
For Index = 1 To Len(TestChars)
Char = Mid(TestChars, Index, 1)
If InStr(allowedChars, Char) = 0 Then BoolTest = False
Next Index
Set RangeTemp = RangeTestChars.Offset(0, 1) ' change offset to what suits your purpose
RangeTemp.Value = BoolTest
If RangeBooleans Is Nothing Then
Set RangeBooleans = RangeTestChars
Else
Set RangeBooleans = Union(RangeBooleans, RangeTemp)
End If
Next RangeTestChars
Set AllCharsValid = RangeBooleans
End Function
cf 2) If the length of the test string is zero, the function will return True for the cell in question, which may not be desirable.
cf 3) There is a limit to how many characters an Excel cell can contain, read more here. I suppose, if you concatenated some very long strings and sent them to the function, you could reach the integer limit of +32767, which would cause a run-time error due to the integer Index variable. However, since the character limit of Excel cells is exactly +32767, the function should work as is without any problems.
cf 4) None that I know of.
cf 5) This is not the easiest thing to achieve, but there is help to be found here.
So I am getting an error at the beginning of my code, an error I didn't use to get last time I opened and edited my VBA code. Any ideas? Here is part of it. When I try to step through the code, I get the error: "Object required" and my sub line (first line) is highlighted. Any ideas how I can fix this?
Sub ManagerCashflow()
'---------------------------Declare all the variables---------------------------
'------Define object names------
'Dim i As Integer
'Dim c As Integer
Dim AUM_Cash_Projections_folder_pathname As String
Dim AUM_Cash_Projections_FOLDER_YEARMONTH_pathname As String
Dim AUM_Cash_Projections_filename_DATE As String
Dim AUMCshf_wb As Workbook
Dim MngrCshF_wb As Workbook
'Dim CshF_lr As Integer
'Dim PE_r As Integer
'Dim lstmanager_r As Integer
'------Set/call the objects to a destination------
'Worksheets
'Manager Cashflow
Set MngrCshF_wb = ThisWorkbook
Set MCF_Current_ws = MngrCshF_wb.Sheets("Sheet1")
'AUM Cash Projections
Set AUM_Cash_Projections_folder_pathname = "https://iportal.casey.org/Risk Management/CFP Reporting/AUM Cash Projection"
Set AUM_Cash_Projections_FOLDER_YEARMONTH_pathname = Right(MCF_Current_ws.Cells(2, 1).Value, 7)
Set AUM_Cash_Projections_filenamedate = MCF_Current_ws.Cells(2, 1).Value
Set AUMCshf_wb = Workbooks.Open(AUM_Cash_Projections_folder_pathname + "/" + AUM_Cash_Projections_FOLDER_YEARMONTH_pathname + "/" + AUM_Cash_Projections_filenamedate)
Set CshF_ws = AUMCshf_wb.Sheets("CashFlow + Projections")
'Master Data with all of the current managers
Set CurrAssets_ws = AUMCshf_wb.Sheets("Master Data")
'... a bunch of other code that works....
End Sub
Not sure why it didn't happen before. You don't need to use set to assign a value to a string.
AUM_Cash_Projections_folder_pathname = "https://iportal.casey.org/Risk Management/CFP Reporting/AUM Cash Projection"
AUM_Cash_Projections_FOLDER_YEARMONTH_pathname = Right(MCF_Current_ws.Cells(2, 1).Value, 7)
AUM_Cash_Projections_filenamedate = MCF_Current_ws.Cells(2, 1).Value
You also need to declare MCF_Current_ws and your other worksheets. It won't tell you unless you have "Option Explicit" at the top of your code, but it's good to do.
Dim MCF_Current_ws as Excel.Worksheet
I'm attempting to take the text in each cell of column A and assign a value to each cell in column B depending on the text in column A. For example, I have a list of versions that are identified by four-letter abbreviations of cities, and all of those versions are regionally assigned to different factories to be produced. So let's say I have an "AUST", "DAFW", "HOUS", and more versions all assigned to the location of "ARLINGTON". How would I most concisely use VBA to automate that once I have all the versions plugged in? Something like
If A2="AUST" Then
B2="ARLINGTON"
ElseIf A2="DAFW" Then
B2="ARLINGTON"
I suppose something like this would work, however I can't believe that there's not a faster and more concise way. Does this make any sense? I've been pulling my hair out for about a week now trying to figure this out... Thanks for any help!
This is a little simpler using OR:
If A2="AUST" OR A2="DAFW" Then
B2="ARLINGTON"
ElseIf A2 = "ABCD" OR A2 = "WZYZ" Then
B2="SOMETHING"
'ETC...
However, if you are iterating over column A, the variable "A2" is strange. But I am not sure how you are doing this. Maybe supply more code and we can help you more.
This could be done with excel formulas as well, though I always prefer to use VBA. This should work the way you want :
Sub yourFunk()
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
arlington = Array("AUST", "DAFW", "HOUS")
otherLocation = Array("XXXX", "YYYY", "ZZZZ")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For x = 2 To lastRow
If stringIsInArray(ws.Cells(x, 1), arlington) Then
ws.Cells(x, 2) = "ARLINGTON"
ElseIf stringIsInArray(ws.Cells(x, 1), otherLocation) Then
ws.Cells(x, 2) = "OTHER LOCATION"
End If
Next x
End Sub
Function stringIsInArray(stringToBeFound As String, arr As Variant) As Boolean
stringIsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
If you need me to explain the code, please do let me know :)
The fastest way is to use Dictionary.
Let's say, your data is present in the following range:
A2 = "AUST"
A3 = "DAFW"
Now, check this code:
'Needs reference to Microsoft Scripting Runtime
Sub Translate()
Dim dic As Dictionary
Dim i As Integer, sTmp As String
Set dic = New Dictionary
dic.Add "AUST", "ARLINGTON"
dic.Add "DAFW", "ARLINGTON"
For i = 2 To 3
sTmp = ThisWorkbook.Worksheets(1).Range("A" & i)
Debug.Print sTmp, "-", dic(sTmp)
Next
Set dic = Nothing
End Sub
Note: This code is just an example!
For further information please see: https://msdn.microsoft.com/en-us/library/office/gg251825.aspx
I have the following Data in Excel.
CHM0123456 SRM0123:01
CHM0123456 SRM0123:02
CHM0123456 SRM0256:12
CHM0123456 SRM0123:03
CHM0123457 SRM0789:01
CHM0123457 SRM0789:02
CHM0123457 SRM0789:03
CHM0123457 SRM0789:04
What I need to do is pull out all the relevent SRM numbers that relate to a single CHM ref. now I have a formular that will do some thing like this
=INDEX($C$2:$C$6, SMALL(IF($B$8=$B$2:$B$6, ROW($B$2:$B$6)-MIN(ROW($B$2:$B$6))+1, ""), ROW(A1)))
however this is a bit untidy and I really want to produce this same using short vb script, do i jsut have to right a loop that will run though and check each row in turn.
For x = 1 to 6555
if Ax = Chm123456
string = string + Bx
else
next
which should give me a final string of
SRM0123:01,SRM123:02,SRM0256:12,SRM0123:03
to use with how i want.
Or is ther a neater way to do this ?
Cheers
Aaron
my current code
For x = 2 To 6555
If Cells(x, 1).Value = "CHM0123456" Then
outstring = outstring + vbCr + Cells(x, 2).Value
End If
Next
MsgBox (outstring)
End Function
I'm not sure what your definition of 'neat' is, but here is a VBA function that I consider very neat and also flexible and it's lightning fast (10k+ entires with no lag). You pass it the CHM you want to look for, then the range to look in. You can pass a third optional paramater to set how each entry is seperated. So in your case you could write (assuming your list is :
=ListUnique(B2, B2:B6555)
You can also use Char(10) as the third parameter to seperat by line breaks, etc.
Function ListUnique(ByVal search_text As String, _
ByVal cell_range As range, _
Optional seperator As String = ", ") As String
Application.ScreenUpdating = False
Dim result As String
Dim i as Long
Dim cell As range
Dim keys As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
On Error Resume Next
For Each cell In cell_range
If cell.Value = search_text Then
dict.Add cell.Offset(, 1).Value, 1
End If
Next
keys = dict.keys
For i = 0 To UBound(keys)
result = result & (seperator & keys(i))
Next
If Len(result) <> 0 Then
result = Right$(result, (Len(result) - Len(seperator)))
End If
ListUnique = result
Application.ScreenUpdating = True
End Function
How it works: It simple loops through your range looking for the search_string you give it. If it finds it, it adds it to a dictionary object (which will eliminate all dupes). You dump the results in an array then create a string out of them. Technically you can just pass it "B:B" as the search array if you aren't sure where the end of the column is and this function will still work just fine (1/5th of a second for scanning every cell in column B with 1000 unique hits returned).
Another solution would be to do an advancedfilter for Chm123456 and then you could copy those to another range. If you get them in a string array you can use the built-in excel function Join(saString, ",") (only works with string arrays).
Not actual code for you but it points you in a possible direction that can be helpful.
OK, this might be pretty fast for a ton of data. Grabbing the data for each cell takes a ton of time, it is better to grab it all at once. The the unique to paste and then grab the data using
vData=rUnique
where vData is a variant and rUnique is the is the copied cells. This might actually be faster than grabbing each data point point by point (excel internally can copy and paste extremely fast). Another option would be to grab the unique data without having the copy and past happen, here's how:
dim i as long
dim runique as range, reach as range
dim sData as string
dim vdata as variant
set runique=advancedfilter(...) 'Filter in place
set runique=runique.specialcells(xlCellTypeVisible)
for each reach in runique.areas
vdata=reach
for i=lbound(vdata) to ubound(vdata)
sdata=sdata & vdata(i,1)
next l
next reach
Personally, I would prefer the internal copy paste then you could go through each sheet and then grab the data at the very end (this would be pretty fast, faster than looping through each cell). So going through each sheet.
dim wks as worksheet
for each wks in Activeworkbook.Worksheets
if wks.name <> "CopiedToWorksheet" then
advancedfilter(...) 'Copy to bottom of list, so you'll need code for that
end if
next wks
vdata=activeworkbook.sheets("CopiedToWorksheet").usedrange
sData=vdata(1,1)
for i=lbound(vdata) + 1 to ubound(vdata)
sData=sData & ","
next i
The above code should be blazing fast. I don't think you can use Join on a variant, but you could always attempt it, that would make it even faster. You could also try application.worksheetfunctions.contat (or whatever the contatenate function is) to combine the results and then just grab the final result.
On Error Resume Next
wks.ShowAllData
On Error GoTo 0
wks.UsedRange.Rows.Hidden = False
wks.UsedRange.Columns.Hidden = False
rFilterLocation.ClearContents