PDA

View Full Version : [SOLVED:] Custom Function Wtih Range in Another Sheet



D_Marcel
05-26-2023, 01:03 AM
Hi, VBAX Members.
It's been a long time I don't post here, but I decided to seek for help after finding not many sources for the issue I am running into.
I wrote a custom "PROPER" function, with a reference table that contains words to be returned accordingly. So, for instance:

=PROPER("USA")
It will return "Usa"

=ENH_PROPER("USA")
If I set in the table as "USA", then it returns "USA"

When calling from another worksheet, even though I am fully qualifying the range, it simply stops running the code without issuing any error message:


Function ENH_PROPER(SOURCE_VALUE As String) As String
Dim SOURCE_WORKBOOK As Workbook
Dim SOURCE_WORKSHEET As Worksheet
Dim SOURCE_RANGE As Range
Dim SOURCE_CELL As Range
Dim DICT_INDEX As Single
Dim TARGET_STRING() As String
Dim SPLIT_STRING As Variant
Dim RETURN_STRING As String
Dim REFERENCE_TABLE As Scripting.Dictionary
Set SOURCE_WORKBOOK = ThisWorkbook
Set SOURCE_WORKSHEET = SOURCE_WORKBOOK.Worksheets("Tables")
Set SOURCE_RANGE = SOURCE_WORKBOOK.SOURCE_WORKSHEET.Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Set REFERENCE_TABLE = New Dictionary
REFERENCE_TABLE.CompareMode = TextCompare


Is this really possible? Should I select the worksheet when reading and loading the values?
Thanks a lot for any guidance! =D

Aflatoon
05-26-2023, 03:26 AM
This line:



Set SOURCE_RANGE = SOURCE_WORKBOOK.SOURCE_WORKSHEET.Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))


should be:



Set SOURCE_RANGE = SOURCE_WORKSHEET.Range(SOURCE_WORKSHEET.Cells(2, 1), SOURCE_WORKSHEET.Cells(Rows.Count, 1).End(xlUp))


though it would be better to pass the table range as an argument to the UDF really.

Paul_Hossler
05-26-2023, 08:47 AM
Seems that you have the recurring overhead of creating and populating the dictionary each time you use the function

Maybe consider using a sub to load the dictionary once and then apply the formatting to all cells in the range

D_Marcel
05-28-2023, 11:37 PM
Hi, Aflatoon, Paul Hossler.
Thanks a lot! It's working now.

Following the recommendation, one Sub to load the values once:



Public REFERENCE_TABLE As Scripting.Dictionary

Sub Load_Tables()
Dim SOURCE_WORKBOOK As Workbook
Dim SOURCE_WORKSHEET As Worksheet
Dim SOURCE_RANGE As Range
Dim SOURCE_CELL As Range
Set SOURCE_WORKBOOK = ThisWorkbook
Set SOURCE_WORKSHEET = SOURCE_WORKBOOK.Worksheets("Tables")
Set SOURCE_RANGE = SOURCE_WORKSHEET.Range(SOURCE_WORKSHEET.Cells(2, 1), SOURCE_WORKSHEET.Cells(Rows.Count, 1).End(xlUp))
Set REFERENCE_TABLE = New Dictionary
REFERENCE_TABLE.CompareMode = TextCompare
For Each SOURCE_CELL In SOURCE_RANGE
If Not REFERENCE_TABLE.Exists(SOURCE_CELL.Value) Then
REFERENCE_TABLE.Add SOURCE_CELL.Value, SOURCE_CELL.Row - 2
End If
Next SOURCE_CELL
Set SOURCE_CELL = Nothing
Set SOURCE_RANGE = Nothing
Set SOURCE_WORKSHEET = Nothing
Set SOURCE_WORKBOOK = Nothing
End Sub


Then, the function, which I can call from any worksheet:



Function ENH_PROPER(SOURCE_VALUE As String) As String
Dim DICT_INDEX As Single
Dim TARGET_STRING() As String
Dim SPLIT_STRING As Variant
Dim RETURN_STRING As String
TARGET_STRING = Split(SOURCE_VALUE, " ")
For Each SPLIT_STRING In TARGET_STRING
If REFERENCE_TABLE.Exists(SPLIT_STRING) Then
DICT_INDEX = REFERENCE_TABLE(SPLIT_STRING)
RETURN_STRING = RETURN_STRING & " " & REFERENCE_TABLE.Keys(DICT_INDEX)
Else
RETURN_STRING = RETURN_STRING & " " & StrConv(SPLIT_STRING, vbProperCase)
End If
Next SPLIT_STRING
ENH_PROPER = Trim(RETURN_STRING)
End Function