Referencing a cell with multiple variables - vba

I have defined 2 variables string and integer respectively. Using both the variable in need to reference a cell and pluck the data. Could anyone help in doing this?
With Page 3
.activate
Dim OracleProjType as String -> stores the value "C"
Dim SearchProjNameRow as Integer -> Stores the value "6"
Dim OracleProjTypeData as string -> Stores the data of "C6" cell
OracleProjTypeData = .Range(" " & OracleProjType & ":" & SearchProjNameRow).Value -> Getting an error here as "Run time error 1004, Application - Object defined error"
End with

Try
Option Explicit
Public Sub TEST()
Dim OracleProjType As String
Dim SearchProjNameRow As Long
Dim OracleProjTypeData As String
OracleProjType = "C" '<==Assign the value to the variable
SearchProjNameRow = 6
With Worksheets("Sheet3") '<== Work with that sheet using with so no activate
OracleProjTypeData = .Range(OracleProjType & SearchProjNameRow).Value '<==Concatenate values to create range reference
Debug.Print OracleProjTypeData
End With
End Sub

Related

VBA Match Function on combo box

I am trying to get a form to populate data from a sheet using cell Z as the lookup reference.
The dropdown on the form showing my list of issue references works. When I select an item from said list to populate the form I get the mismatch error.
Also, my range in Z column is a mix of letters and numbers. I did change I to variant but no luck
The application.match is returning an error. Any ideas?
Run Time error '13': Type Mismatch
Private Sub ComboBox2_Change()
If Me.ComboBox2.Value <> "" Then
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Inbound Issues")
Dim i As Integer
i = Application.Match(VBA.CLng(Me.ComboBox2.Value), sh.Range("Z:Z"), 0)
Me.TextBox1.Value = sh.Range("H" & i).Value
End If
End Sub
Private Sub ComboBox2_Change()
If Me.ComboBox2.Value <> "" Then
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Inbound Issues")
Dim i As Integer
i = Application.Match(VBA.Str(Me.ComboBox2.Value), sh.Range("Z:Z"), 0)
Me.TextBox1.Value = sh.Range("H" & i).Value
End If
End Sub
Change Clng to Str

How to set a different link in each cell in a range?

I'm programming a Macro in VB for Excel 2013 that search for coincidences in different worksheets, and add a link to the cells that match.
I'm havin torubles to insert the link in the cell, since the link must be different for a range of cells, I need help here.
Here is my code
Dim bufferDetails As String
Dim tmpCell As String
Dim spot As String
Dim cell As Variant
Dim cellSpots As Variant
For Each cell In Worksheets("MMS-Locations").Range("D2:D1833")
If (cell.Value2 = "NULL") Then
cell.Value2 = "NULL"
Else
tmpCell = cell.Text
'A62
If (Left(tmpCell, 3) = "A62") Then
spot = spotName(tmpCell)
For Each cellSpots In Worksheets("DetailedMap").Range("G60:CF123")
If (cellSpots.Value2 = spot) Then
For Each linkToSpot In Worksheets("MMS-Locations").Range("H2:H1833")
Worksheets("MMS-Locations").Hyperlinks.Add _
Anchor:=Range(linkToSpot), _
Address:="http://example.microsoft.com", _
ScreenTip:="Microsoft Web Site", _
TextToDisplay:="Microsoft"
Next linkToSpot
Debug.Print ("Encontrado " + cellSpots)
End If
Next cellSpots
End If
End If
Next cell
End Sub
Function spotName(fullName As String) As String
Dim realSpot As String
Dim lenght As Integer
lenght = Len(fullName) - 3
realSpot = Right(fullName, lenght)
spotName = realSpot
End Function
As I was thinking the linkToSpot variable contains the actual cell in the range, so I can move my selection of the sell, but my code fails in there with this error:
Error in the Range method of the '_Global' object,
Just for reference, here is what I use to convert a phone number to an email for texting..setting it as a hyperlink in the current cell.
ActiveCell.Value = myNumbr
Set myRange = ActiveCell
ActiveSheet.Hyperlinks.Add anchor:=myRange, Address:="mailto:" & myRange.Value, TextToDisplay:=myRange.Value`
Keep your code simple to start with, until you find a working script, then add other items. Make good use of the F8 key to step through your code to find out exactly where an error occurs.

VBA - worksheet parameter in function

I have a function 'mergeCategories' taking into argument (worksheet, worksheet, long). The idea is to read the value of a cell and replace it with another value based on a mapping table.
The content of the function works well when I run it as a sub and declaring the values inside the sub. But when i call the function from a sub, i get error Run-time error 424 Object Required at the line:
last_row_matching = ws_matching.Range("A1").End(xlDown).Row
Apparently, there is an issue with the worksheet ws_matching
Here is the function:
Function mergeCategories(ws_source As Worksheet, ws_macthing As Worksheet, last_row_used As Long) As Boolean
'Variables
'Result boolean
Dim final_result As Boolean
final_result = False
'Source category name
Dim src_cat_name As String
'Destination category name
Dim dest_cat_name As String
'Index of last row in matching table
Dim last_row_matching As Long
last_row_matching = ws_matching.Range("A1").End(xlDown).Row
MsgBox "Last row matching " & last_row_matching
'Result of the matching (as range, .Value used to get name)
Dim result_range As Range
'Loop
For i = 1 To last_row_used
'get the source category name
src_cat_name = ws_source.Range("A" & i).Value
MsgBox "The category name pulled is " & src_cat_name
'Find the mapping
Set result_range = ws_matching.Range("A2:A" & last_row_matching).Find(src_cat_name)
dest_cat_name = result_range.Offset(0, 1).Value
MsgBox "The new category name is " & dest_cat_name
ws_source.Range("A" & i).Value = dest_cat_name
ws_source.Range("A" & i).Activate
MsgBox "Check"
Next i
final_result = True
End Function
Here is the macro:
Sub test_mergeCategories()
Dim ws_matching As Worksheet
Set ws_matching = Sheets("Matching")
Dim ws_source As Worksheet
Set ws_source = Sheets("Temp_Import")
Dim last_row_used As Long
last_row_used = ws_source.Range("A1").End(xlDown).Row
Call mergeCategories(ws_source, ws_matching, last_row_used)
End Sub
Any idea of what is the issue?

Excel - User defined function getting is being called even when not active

I have a user defined function in excel. The function contains Application.Volatile at the top and it works great.
The problem I am experiencing now is that when I have the workbook open (lets call it workbook 1) together with another workbook (call it workbook 2), every time I make a change to workbook 2, all cells in workbook 1 that call this UDF gets a #VALUE! error.
Why is this happening?
I hope I provided enough info. If not please let me know.
Thanks
David
Hi guys, thanks for the help.
Sorry about that... here is the code:
Function getTotalReceived(valCell As Range) As Variant
Application.Volatile
If ActiveWorkbook.Name <> "SALES.xlsm" Then Return
Dim receivedWs As Worksheet, reportWs As Worksheet
Dim items As Range
Set reportWs = Worksheets("Report")
Set receivedWs = Worksheets("Received")
Dim myItem As String, index As Long
myItem = valCell.Value
Set items = receivedWs.Range("A:A")
index = Application.Match(myItem, items, 0)
If IsError(index) Then
Debug.Print ("Error: " & myItem)
Debug.Print (Err.Description)
GoTo QuitIt
End If
Dim lCol As Long, Qty As Double, mySumRange As Range
Set mySumRange = receivedWs.Range(index & ":" & index)
Qty = WorksheetFunction.Sum(mySumRange)
QuitIt:
getTotalReceived = Qty
End Function
Your problem is with the use of ActiveWorkbook,ActiveWorksheet or ActiveCell or other Active_____ objects in your UDF. Notice that Application.Volitile is an application-level property. Anytime you switch sheets, books, cells, charts, etc. the corresponding "active" object changes.
As an example of proper UDF coding practice I put together this short example:
Function appCallerTest() As String
Dim callerWorkbook As Workbook
Dim callerWorksheet As Worksheet
Dim callerRange As Range
Application.Volatile True
Set callerRange = Application.Caller
Set callerWorksheet = callerRange.Worksheet
Set callerWorkbook = callerWorksheet.Parent
appCallerTest = "This formula is in cell: " & callerRange.Address(False, False) & _
" in the sheet: " & callerWorksheet.Name & _
" in the workbook: " & callerWorkbook.Name
End Function
Function getTotalReceived(valCell As Range) As Variant
Application.Volatile
Dim index, v, Qty
v = valCell.Value
'do you really need this here?
If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Function
If Len(v) > 0 Then
index = Application.Match(v, _
ThisWorkbook.Sheets("Report").Range("A:A"), 0)
If Not IsError(index) Then
Qty = Application.Sum(ThisWorkbook.Sheets("Received").Rows(index))
Else
Qty = "no match"
End If
Else
Qty = ""
End If
getTotalReceived = Qty
End Function
You actually have 2 errors in your function. The first was partially addressed by Mr. Mascaro - you need to use the Range reference that was passed to the function to resolve the Workbook that it is from. You can do this by drilling down through the Parent properties.
The second issue is that you are testing to see if Application.Match returned a valid index with the IsError function. This isn't doing what you think it's doing - IsError checks to see if another cell's function returned an error, not the previous line. In fact, if Application.Match raises an error, it is in your function so you have to handle it. I believe the error you need to trap is a type mismatch (error 13).
This should resolve both issues:
Function getTotalReceived(valCell As Range) As Variant
Application.Volatile
Dim book As Workbook
Set book = valCell.Parent.Parent
If book.Name <> "SALES.xlsm" Then Exit Function
Dim receivedWs As Worksheet, reportWs As Worksheet
Dim items As Range
Set reportWs = book.Worksheets("Report")
Set receivedWs = book.Worksheets("Received")
Dim myItem As String, index As Long
myItem = valCell.Value
Set items = receivedWs.Range("A:A")
On Error Resume Next
index = Application.Match(myItem, items, 0)
If Err.Number = 13 Then GoTo QuitIt
On Error GoTo 0
Dim lCol As Long, Qty As Double, mySumRange As Range
Set mySumRange = receivedWs.Range(index & ":" & index)
Qty = WorksheetFunction.Sum(mySumRange)
QuitIt:
getTotalReceived = Qty
End Function

Find cell based on a property

I need to find a cell into a worksheet but I'd like to avoid looking for a string.
The problem I have is that the worksheet will be edited by my client. If ever he decides to write the string I'm looking for before the good one, the app will crash.
Sub FindSpecificCell()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("TP 1")
Dim myRange As Range
Dim rangeFinal As Range
Set monRange = ws.Range("A:AJ")
Set rangeFinal = myRange.Find("Description du test")
Debug.Print " "
Debug.Print "Looking for ""Description du test"" in TP 1 "
Debug.Print "column : " & rangeFinal.Column
Debug.Print "row : " & rangeFinal.Row
End Sub
Is there a way to insert a kind of property inside the cell in order to be sure that I'm working on the good one?
You can't associated properties with a specific cell directly, but you can use properties with the worksheet to store this information. I've used a couple methods like this before:
'Set the provided value of the custom property with the provided name in the provided sheet.
Private Sub SetCustomPropertyValue(InSheet As Worksheet, WithPropertyName As String, WithValue As Variant)
Dim objCP As CustomProperty
Dim bolFound As Boolean
bolFound = False 'preset.
For Each objCP In InSheet.CustomProperties
'if this property's name is the one whose value is sought...
If (StrComp(objCP.Name, WithPropertyName, vbTextCompare) = 0) Then
objCP.Value = WithValue
bolFound = True
Exit For
End If
Next
'if the property didn't already exist on the sheet, add it.
If (Not bolFound) Then Call InSheet.CustomProperties.Add(WithPropertyName, WithValue)
End Sub
'Return the value of the custom property with the provided name in the provided sheet.
Private Function GetCustomPropertyValue(InSheet As Worksheet, WithPropertyName As String) As Variant
Dim objCP As CustomProperty
GetCustomPropertyValue = Empty
For Each objCP In InSheet.CustomProperties
'if this property's name is the one whose value is sought...
If (StrComp(objCP.Name, WithPropertyName, vbTextCompare) = 0) Then
GetCustomPropertyValue = objCP.Value
Exit For
End If
Next
End Function
Then you can do something like this to write and read back values:
Sub test()
Dim strPropName As String
strPropName = "MyRange_" & Selection.Address
Dim strWhatIWantToStore As String
strWhatIWantToStore = "Here's what I want to store for this range"
Call SetCustomPropertyValue(ActiveSheet, strPropName, strWhatIWantToStore)
MsgBox GetCustomPropertyValue(ActiveSheet, strPropName)
End Sub