Create Excel User Defined Function (UDF) that can sum mixed numbers and text

1k views Asked by At

Data example in excel:
COL A B C D F..... 1 SL..... 2 SL8 AL4 CD3 CN5 CD4 AL8

I am summing conditionally, based on the letter identifier within the cell. The UDF is entered into a cell (F2) =SumDigByLTR2(A2:C2,F1), where F1 - I1 are the conditions to sum (the letters, SL, AL etc). Result should be:
SL=8 AL=12 CD=7 CN=5

I created this user defined function in VBA (below). I modified some code I found online. It worked at first, then mysteriously stopped working. I don't recall changing anything the XLS or VBA. Thoughts?
You can ignore the commented out "delim" lines. I was trying to have an option to set a delimiter between letters. It didn't work, so i just use a space.

Option Explicit
Function SumDigByLTR2(rg As Range, ltr As String) As Double
Dim c As Range   'c = a cell
Dim delimiter As String
Dim InStrResult As Long  'returns the position of "ltr" in the cell e.g. abc34, if ltr="c", then Instr() = 3
Dim MidResult As Long
Dim numltr As Integer 'number of characters in the critera, i.e. AL or A
'Dim delim_text As String 'this will identify the user preferred demlimiter text.
Dim StartPos As Integer  'position of ltr + number of characters in the critera, i.e. AL or A
Dim DelimPos As Integer  'position of delimiter after "ltr"
Dim numlen As Integer  'returns length of the desired numbers i.e. "3" =1 or "10" =2

For Each c In rg
'delimiter = Sheet7.Range("O8").Value
    InStrResult = InStr(1, c.Text, ltr, vbTextCompare)
    If InStr(1, c.Text, ltr, vbTextCompare) > 0 Then

        StartPos = InStrResult + Len(ltr)
        DelimPos = InStr(InStrResult, c.Text, " ") 'Sheet7.Cells(8, 15).Value)  '"O"=15

            If DelimPos = 0 Then
               MidResult = Right(c.Text, Len(c.Text) - StartPos + 1)  '"+1" because if cell=al3; starpos will = 3 & len(cell)=3; therefore   Len-startpos=0
            Else
               numlen = DelimPos - StartPos + 1
               MidResult = Mid(c.Text, StartPos, numlen)
            End If

        SumDigByLTR2 = SumDigByLTR2 + MidResult

    End If
Next c
End Function


'Original
'http://www.pcreview.co.uk/forums/excel-extract-and-sum-numerals-mixed-text-numeral-cell-range-t937450.html

'Option Explicit
'Function SumDigByLtr(rg As Range, ltr As String) As Double

'Dim c As Range

'For Each c In rg
'If InStr(1, c.Text, ltr) > 0 Then
'SumDigByLtr = SumDigByLtr + Replace(c.Text, ltr, "")

'End If
'Next c
'End Function

UPDATE #1, Nov 25 2015 I discovered what was breaking the UDF for me.

Excel 2010 seems to have created a new set of worksheets and renamed all the originals, e.g. Sheet10 becomes Sheet101, Sheet13 becomes Sheet131. This causes the UDF to stop functioning. The "new" "sheet10" and "sheet13" do not seem to exist anywhere but in the VBA project window. The "new" sheets have a blue icon next to them.

I had to change the references in the UDF to the new sheet names since Excel created "new" sheets and renamed my "old" sheets on its own. No more #VALUE errors.

enter image description here enter image description here

enter image description here

Does anyone know what caused Excel/VBA to create these non-existent sheets and rename the original sheets?

UPDATE #2, 1/6/2016 I copied all real, existing sheets to a new workbook in early Dec.
As of today, the formulas in this new workbook are all errors (#VALUE) again when I opened it. Excel has not created the non-existent sheets as seen in my last update. Last week the XLS & formulas were working and I made no changes. The original workbook (the one shown in the pix w/ the non-existent worksheets) does not have the #VALUE errors. Both workbooks are on the same computer and have been updated together over the last month+ for comparison purposes.

UPDATE3, 1/6/2016 I just accidentally moved a text cell, then clicked undo, and all the #VALUE errors went away and I now have all the right calculations. WTF.

1

There are 1 answers

0
mechengr02 On BEST ANSWER

This was my final UDF.

Option Explicit
Function Sumbytext(rg As Range, ltr As String) As Double
'Similar to Excel SumIf, except that text can be in the cell with the number.
'That text ("ltr") can identify the number, as a condition to sum.
'e.g. Cell1 (D5 T8 Y3), Cell2(D3 A2), Cell3 (T8) >>> Sums: D=8 T=16 Y=3 A=2

Dim c As Range   'c = a cell
Dim InStrResult As Integer  'returns the position of "ltr" in the cell 
e.g. abc34, if ltr="c", then Instr() = 3
Dim MidResult As Double
Dim numltr As Integer 'number of characters in the critera, i.e. AL or A
Dim StartPos As Integer  'position of ltr + number of characters in the critera, i.e. AL or A
Dim DelimPos As Integer  'position of delimiter after "ltr"
Dim numlen As Integer  'returns length of the desired numbers i.e. "3" =1 or "10" =2
Dim Abbr As Range  'abbreviation of holiday - this is displayed on the calendar
Dim rgAbbr As Range  'the list of abbreviations corresponding to the list of holidays

Set rgAbbr = Worksheets("Holidays").Range("List_HolAbbr")

For Each c In rg
  For Each Abbr In rgAbbr
    If UCase(c) = UCase(Abbr) Then GoTo skipcell   'skip cell if the holiday names are in the cell >> 'Labor day' gives an error because the function looking for a cell containing "LA".  Therefore exclude "Labor".
    Next Abbr
     If InStr(1, c.Text, UCase("OCT"), vbTextCompare) > 0 Then GoTo skipcell 'skip cell if it inscludes "Oct".  >> results in error due to the "CT" being used as "ltr".
     InStrResult = InStr(1, c.Text, ltr, vbTextCompare)
     If InStrResult > 0 Then
        StartPos = InStrResult + Len(ltr)
        DelimPos = InStr(InStrResult, c.Text, " ")

        If DelimPos = 0 Then
          MidResult = Right(c.Text, Len(c.Text) - StartPos + 1) '"+1" because if cell=al3; starpos will = 3 & len(cell)=3; therefore Len-startpos=0
        Else
      numlen = DelimPos - StartPos + 1
      MidResult = Mid(c.Text, StartPos, numlen)
        End If

        Sumbytext = Sumbytext + MidResult

    End If
skipcell:
Next c
End Function

UPDATE #1 The workbook problems shown in UPDATE#1 above seemed to be what was breaking my UDF due to the sheet names being renamed automatically by Excel. I had to change the references in the UDF to the new sheet names since Excel created "new" sheets and renamed my "old" sheets on its own. No more #VALUE errors.

UPDATE #2:
I don't know how or why the #VALUE error was fixed in UPDATE #2 above. Suggestions?