CODEWITHSUNDEEP
vbauser-defined-functions
Vijay Seshan
Vijay Seshan

Reputation: 11

VBA User Defined Function #VALUE error

I have four sheets:

  1. INVESTMENTS 

    sample row-1: ABC, INV_ID1    
sample row-2: ABC, INV_ID2    
sample row-3: XYZ, INV_ID3    
sample row-4: XYZ, INV_ID4

  2. RETURNS-ABC 

    sample row: date1, status_INV_ID_1, returns_INV_ID_1, 
            status_INV_ID_2, returns_INV_ID_2,     
            totalABC=returns_INV_ID_1+returns_INV_ID_2

  3. RETURNS-XYZ 

    sample row: date1, status_INV_ID_3, returns_INV_ID_3, 
            status_INV_ID_4, returns_INV_ID_4, 
            totalXYZ=returns_INV_ID_3+returns_INV_ID_4

  4. TOTALS 

    sample row: date1, all_totals

I want all_totals = totalABC + totalXYZ

Since the number of returns sheets can increase in future and I intend to provide a filtering based on owner(ABC/XYZ etc.), I wrote the following vba function to be called from all_totals column of "TOTALS" sheet with date1 as parameter. This does not work and my best guess is that this may be due to some limitation of "User Defined Function".

However, as you can see below, I am not altering any other cell value, only of the cell from which the function is being called. Just wondering if anyone has any suggestions on how to fix this?

'========
'Returns the current month total due for ALL
'Data is pulled from individual owner sheets
Function getCurrentMonthTotalDue(theDate As Date) As Integer
' theDate       - MANDATORY: Month for which data is needed
' RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST - is a named range of all installment dates in the "RETURNS-XXX" sheets
' RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST - is a named range of totals in the "RETURNS-XXX" sheets

 Dim uniqueOwnerList as Variant 
 Dim returnsPerOwnerDateRange, returnsPerOwnerTotalDueRange as Range
 Dim i,j as integer
 Dim totalDue as Integer

 totalDue = 0

 uniqueOwnerList = getUniqueOwnerList 

 for i =  LBound(uniqueOwnerList, 1) To UBound(uniqueOwnerList, 1)
    'Construct the ranges to refer
    returnsPerOwnerDateRange     = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range(RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST)        
    returnsPerOwnerTotalDueRange = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range(RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST)  '=====> CONTROL HITS THIS BREAKPOINT

    for j = 1 to  returnsPerOwnerDateRange.Count                                                                                          '=====> BUT DOES NOT HIT THIS ONE AND NO ERROR IS SHOWN
     if (returnsPerOwnerDateRange(j).value = theDate) then
      totalDue = totalDue + returnsPerOwnerTotalDueRange(j)
     end if
    next j
 next i 

'Return value
getCurrentMonthTotalDue = totalDue

End Function

EDIT: Including the full code to provide more context:

Option Explicit

'GLOBALS
'--------
'Header names
Public Const COMMITTED_INVESTMENTS_OWNER_LIST                = "COMMITTED_INVESTMENTS_OWNER_LIST"
Public Const COMMITTED_INVESTMENTS_TICKET_LIST               = "COMMITTED_INVESTMENTS_TICKET_LIST"
Public Const COMMITTED_INVESTMENTS_ID_LIST                   = "COMMITTED_INVESTMENTS_ID_LIST"
Public Const COMMITTED_INVESTMENTS_SHEET_PREFIX              = "INVESTMENTS"
Public Const RETURNS_PER_OWNER_SHEET_PREFIX                  = "RETURNS-"
Public Const RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST     = "RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST"
Public Const RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST         = "RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST"
Public Const RETURNS_PER_OWNER_INSTALLMENT_DATE_COLUMN_ID    = 1
Public Const RETURNS_PER_OWNER_FIRST_INVESTMENT_ID_COLUMN_ID = 2


'UTILITY
'-------

'========
'Returns column number in the range containing the given header string
'Input range is assumed to be a single row range
Function getColumnNumber(theRange as Range, theColumnHeader as String)
' theRange - MANDATORY: The range in which search is to be made
' theColumnHeader - MANDATORY: The string to be searched

Dim myRow As Range
Dim myCell As Range
Dim myColumn as long

myColumn = -1

for each myRow in theRange.rows
 for each myCell in myRow.Cells
  myColumn = myColumn + 1
  if myCell.Value = theColumnHeader then
   getColumnNumber = myColumn
   return
  end if
 next myCell
next myRow
getColumnNumber = -1
End Function

'FUNCTIONALITY
'-------------

'========
'Returns a list of unique entries from a given range
Function getUniqueListFromRange(theSourceRange as Range)
'Code courtesy Jean-François Corbett@stackoverflow
    Dim varIn As Variant
    Dim varUnique As Variant
    Dim iInRow As Long
    Dim iUnique As Long
    Dim nUnique As Long
    Dim isUnique As Boolean

    varIn = theSourceRange 
    ReDim varUnique(1 To UBound(varIn, 1) * UBound(varIn, 2))

    nUnique = 0
    For iInRow = LBound(varIn, 1) To UBound(varIn, 1)

            isUnique = True
            For iUnique = 1 To nUnique
                If varIn(iInRow, 1) = varUnique(iUnique) Then
                    isUnique = False
                    Exit For
                End If
            Next iUnique

            If isUnique = True Then
                nUnique = nUnique + 1
                varUnique(nUnique) = varIn(iInRow, 1)
            End If

    Next iInRow
    '// varUnique now contains only the unique values. 
    '// Trim off the empty elements:
    ReDim Preserve varUnique(1 To nUnique)

    getUniqueListFromRange = varUnique
End Function

'========
Function getUniqueOwnerList()
 Dim myRange As Range

 Set myRange = Sheets("INVESTMENTS").Range("COMMITTED_INVESTMENTS_OWNER_LIST")

 getUniqueOwnerList = getUniqueListFromRange(myRange)
End Function

'========
Function getUniqueTicketList()
 Dim myRange As Range

 Set myRange = Sheets("INVESTMENTS").Range("COMMITTED_INVESTMENTS_TICKET_LIST")

 getUniqueTicketList = getUniqueListFromRange(myRange)
End Function

'========
Function getUniqueInvestmentIDList()
 Dim myRange As Range

 Set myRange = Sheets("INVESTMENTS").Range("COMMITTED_INVESTMENTS_ID_LIST")

 getUniqueInvestmentIDList = getUniqueListFromRange(myRange)
End Function

'========
Function isItemPresentinList(theItem as String, theList as Variant) as Boolean
Dim i as long
isItemPresentinList = False

for i=LBound(theList, 1) To UBound(theList, 1)
 if (theList(i) = theItem) then
  isItemPresentinList = True
  return
 end if
next i

End Function

'========
Function getColumnID(theColumnHeader as String, theHeaderRange as Range) as long
 Dim columnIndex as long
 Dim myCell as Range

 columnIndex = 0
 getColumnID = 0

 for each myCell in theHeaderRange
  columnIndex = columnIndex + 1
  if myCell.Value = theColumnHeader then
   getColumnID = columnIndex
   return
  end if
 next myCell

End Function

'========
Function getInvestmentIDIndex(theInvestmentID as String) as long
 Dim theIndex as long

 theIndex = 0
 'If provided SVR-1, will return 1
 theIndex = Instr(theInvestmentID,"-")

 if theIndex = 0 then
  theIndex = -1
 else
  theIndex = theIndex + 1
 end if

 getInvestmentIDIndex = theIndex

End Function

'========
Function getAllInvestmentIDForOwner (theOwner as String) as Variant
 Dim i  as long
 Dim j  as long
 Dim theInvestmentOwnerRange as Range
 Dim theInvestmentIDRange as Range
 Dim theInvestmentList as Variant

 j = 0
 ReDim theInvestmentList(1 To UBound(theInvestmentIDRange, 1) * UBound(theInvestmentIDRange, 2))

 Set theInvestmentOwnerRange = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_OWNER_LIST")
 Set theInvestmentIDRange    = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_ID_LIST")

 for i = LBound(theInvestmentOwnerRange, 1) To UBound(theInvestmentOwnerRange, 1)
  if (theInvestmentOwnerRange(i) = theOwner) then
   j = j + 1
   theInvestmentList(j) = theInvestmentIDRange(i)
  end if
 next i

 ReDim Preserve theInvestmentList(1 to j)

 getAllInvestmentIDForOwner = theInvestmentList

End Function

'========
Function getAllInvestmentIDForTicket (theTicketID as String) as Variant
 Dim i  as long
 Dim j  as long
 Dim theInvestmentOwnerRange as Range
 Dim theInvestmentTicketRange as Range
 Dim theInvestmentList as Variant

 j = 0
 ReDim theInvestmentList(1 To UBound(theInvestmentIDRange, 1) * UBound(theInvestmentIDRange, 2))

 Set theInvestmentOwnerRange  = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_OWNER_LIST")
 Set theInvestmentTicketRange = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_TICKET_LIST")

 for i = LBound(theInvestmentTicketRange, 1) To UBound(theInvestmentTicketRange, 1)
  if (theInvestmentTicketRange(i) = theTicketID) then
   j = j + 1
   theInvestmentList(j) = theInvestmentIDRange(i)
  end if
 next i

 ReDim Preserve theInvestmentList(1 to j)

 getAllInvestmentIDForTicket = theInvestmentList

End Function

'========
Function getTicketForInvestmentID (theInvestmentID as String) as String
 Dim i  as long
 Dim j  as long
 Dim theInvestmentIDRange as Range
 Dim theInvestmentTicketRange as Range

 Set theInvestmentIDRange    = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_ID_LIST")
 Set theInvestmentTicketRange = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_TICKET_LIST")

 for i = LBound(theInvestmentIDRange, 1) To UBound(theInvestmentIDRange, 1)
  if (theInvestmentIDRange(i) = theInvestmentID) then
    getTicketForInvestmentID = theInvestmentTicketRange(i)
    return
  end if
 next i

 getTicketForInvestmentID = ""

End Function

'========
'Returns the current month total due for ALL
'Data is pulled from individual owner sheets
Function getCurrentMonthTotalDue(theDate As Date)
' theDate       - MANDATORY: Month for which data is needed

 Dim uniqueOwnerList as Variant 
 Dim returnsPerOwnerDateRange as Range
 Dim returnsPerOwnerTotalDueRange as Range
 Dim i as long
 Dim j as long
 Dim totalDue as long

 totalDue = 0

 uniqueOwnerList = getUniqueOwnerList 

 for i =  LBound(uniqueOwnerList, 1) To UBound(uniqueOwnerList, 1)
    'Construct the ranges to refer
    Set returnsPerOwnerDateRange     = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range("RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST")
    Set returnsPerOwnerTotalDueRange = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range("RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST")

    for j = 1 to  returnsPerOwnerDateRange.CountLarge
     if (returnsPerOwnerDateRange(j).value = theDate) then
      totalDue = totalDue + returnsPerOwnerTotalDueRange(j)
     end if
    next j
 next i 

'Return value
getCurrentMonthTotalDue = totalDue

End Function

'========
'Returns the current month due for the specified parameters
'Data is pulled from individual owner sheets with name matching the template 'RETURNS-XXX'
Function getCurrentMonthDue(theDateRow As long, theOwnerList As Variant, theTicketList As Variant, theInvestmentList As Variant)
' theDateRow        - MANDATORY: RowID of Month for which data is needed
' theOwnerList      - MANDATORY: List of Owner names for which data is needed
' theTicketList     - MANDATORY: List of Ticket IDs for which data is needed
' theInvestmentList - MANDATORY: List of Investment IDs for which data is needed

 Dim uniqueOwnerList as Variant 
 Dim allInvestmentsList as Variant 
 Dim returnsPerOwnerDataRange as Range
 Dim i as long
 Dim j as long
 Dim theColumnID as long

 theColumnID = 0
 uniqueOwnerList = getUniqueOwnerList 

 'FIRST: Loop through all owners mentioned in the filter value
 for i =  LBound(theOwnerList, 1) To UBound(theOwnerList, 1)
    'SECOND: Loop through all investments for the specific owner from the filter values provided
     allInvestmentsList = getAllInvestmentIDForOwner(CStr(theOwnerList(i)))
     for j = LBound(allInvestmentsList, 1) To UBound(allInvestmentsList, 1)
      'THIRD: Check if the ticketID and investmentID match the filter values provided
       if isItemPresentinList(getTicketForInvestmentID(Cstr(allInvestmentsList(j))),theTicketList) AND isItemPresentinList(CStr(allInvestmentsList(j)),theInvestmentList) then
        'Construct the ranges to refer
        Set returnsPerOwnerDataRange     = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & theOwnerList(i)).Range("RETURNS_PER_OWNER_DATA_RANGE")

        'return the correct due amount
        theColumnID = RETURNS_PER_OWNER_FIRST_INVESTMENT_ID_COLUMN_ID*getInvestmentIDIndex(CStr(theInvestmentList(j)))
        getCurrentMonthDue = returnsPerOwnerDataRange (theDateRow)(theColumnID)
        return
       end if
     next j 
 next i 

'Return value
getCurrentMonthDue = 0

End Function

'========
Function getFilteredList(theShape as Shape)
 Dim i As Long
 Dim selectedCount  As Long
 Dim filteredList As Variant

 selectedCount = 0

 With theShape
     ReDim filteredList(1 To .ListCount)

     For i = 1 To .ListCount
         If .Selected(i) Then
           selectedCount = selectedCount + 1
           filteredList(selectedCount) = .List(i)
         End If
     Next i

     ' Trim off the empty elements:
     ReDim Preserve filteredList(1 To selectedCount)

 End With

 getFilteredList = filteredList

end function

'========
Function getOwnerFilteredList
 getOwnerFilteredList = getFilteredList(Sheets("CONSOLIDATED SUMMARY").ListBoxes("List Box 8"))
End function

'========
Function getTicketFilteredList
 getTicketFilteredList = getFilteredList(Sheets("CONSOLIDATED SUMMARY").ListBoxes("List Box 9"))
End function

'========
Function getInvestmentIDFilteredList
 getInvestmentIDFilteredList = getFilteredList(Sheets("CONSOLIDATED SUMMARY").ListBoxes("List Box 10"))
End function

Upvotes: 1

Views: 827

Answers (1)

YowE3K
YowE3K

Reputation: 23974

As Paul Bica mentions in a comment, you are:

  • Not defining your variables as you expect - i.e. returnsPerOwnerDateRange and i are both declared as Variant. (The fact that returnsPerOwnerDateRange is a Variant is the reason why your code doesn't crash on the

    returnsPerOwnerDateRange     = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range(RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST)

    line, because the current statement makes returnsPerOwnerDateRange into a 2-dimensional Variant array containing the values from the range.)

  • Not using Set to assign references to objects such as ranges.

  • Not enclosing range names in double-quotation marks to make them a literal. (As it was, they were being interpreted as variables, such as I assume your RETURNS_PER_OWNER_SHEET_PREFIX is.)

The following code will probably work:

'========
'Returns the current month total due for ALL
'Data is pulled from individual owner sheets
Function getCurrentMonthTotalDue(theDate As Date) As Long ' Should this be Double?
    ' theDate       - MANDATORY: Month for which data is needed
    ' RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST - is a named range of all installment dates in the "RETURNS-XXX" sheets
    ' RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST - is a named range of totals in the "RETURNS-XXX" sheets

    Dim uniqueOwnerList As Variant 
    Dim returnsPerOwnerDateRange As Range, returnsPerOwnerTotalDueRange As Range
    Dim i As Long, j As Long
    Dim totalDue As Long ' Should this be Double?

    totalDue = 0

    uniqueOwnerList = getUniqueOwnerList 

    For i =  LBound(uniqueOwnerList, 1) To UBound(uniqueOwnerList, 1)
        'Construct the ranges to refer
        'Assumes that "RETURNS_PER_OWNER_SHEET_PREFIX" is a global constant
        Set returnsPerOwnerDateRange     = Worksheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range("RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST")        
        Set returnsPerOwnerTotalDueRange = Worksheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range("RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST")

        For j = 1 To  returnsPerOwnerDateRange.Cells.Count
            'NOTE: Referencing the cells within a range using a single index,
            '      rather than a row and column index is a dangerous habit to get into,
            '      but will work if the range is a single row or a single column.
            If returnsPerOwnerDateRange(j).Value = theDate Then
                totalDue = totalDue + returnsPerOwnerTotalDueRange(j).Value
            End If
        Next j
    Next i 

    'Return value
    getCurrentMonthTotalDue = totalDue

End Function

Upvotes: 1

Related Questions