Summing x Ft. in a set cell on every worksheet

I have a vendors spreadsheet that has a length in feet (Ft.) in cell A1. This data is on every worksheet for as many cables as there are. (i.e. sheet 1 A1 100 Ft. , sheet 2 A1 200 Ft. , sheet 3 A1 300 Ft. - every number is followed by a space then "Ft.")
The total should be 600 Ft.

How would you total with text in the same cell? It should go to sheet 1000 A1

If A1 has only text or blank between 1-1000 it would not effect the total sum.

Thanks in advance
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Wayne Taylor (webtubbs)Commented:
Do you have 1000 sheets? Seems a lot.

Anyway, you use a sheet array, like this...

Wayne Taylor (webtubbs)Commented:
I just realised that you probably have text in cell A1 on each sheet. In that case, it won't work. What you can do is get rid of "Ft" on each sheet, but use a custom number format (0 "Ft.") to still display the unit. Then the SUM formula above will work.
you can use the following formula to get the value from each sheet:
=SUM(SUBSTITUTE(INDIRECT("Sheet"&ROW()&"!A1")," ft.",""))
Then you can copy the formula down by the number of sheets and total at the bottom.
Example attached.

The following does the same but with some simple 'error handling'
=IFERROR(SUM(SUBSTITUTE(INDIRECT("Sheet"&ROW()&"!A1")," ft.","")),0)

For your sheet numbers you may need:
=IFERROR(SUM(SUBSTITUTE(INDIRECT("Sheet "&ROW()&"!A1")," Ft.","")),0)
This has a space after the 'Sheet'

Getting them to subtotal does seem to be a job for VBA, if you realy must have the result in na single cell.

Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

byundtMechanical EngineerCommented:
If you are willing to use VBA user-defined functions, you can use a worksheet formula like:

This function will add numbers in the 3D range specified. If text is stored in the cells in that range, any numeric values before the first non-numeric character in each cell will be included in that sum. In other words, the function will add 200 ft, 300 and 500 feet in three cells to get a result of 1000.

See the sample workbook for an example in worksheet "Test 3D functions" cells E12 & E13.

'Put the code in a regular module sheet, just like a macro sub
Function SumVals3D(rgToSum As Variant) As Variant
'Function works just like SUM function, except it adds the values before the first non-numeric text in the 3-D cell range references.
'rgToSum may be single sheet or multi-sheet references to one or more cells _
    Enter 3-D ranges just like in a SUM formula:   =SumVals3D('Sheet 1:Sheet 3'!A1:A7)
'Note: there must be only one SumVals3D function in a formula--the wrong answer will be returned if there is more than one.
Dim cel As Range, rg As Range
Dim iFirstCheck As Integer, iLastCheck As Integer, k As Integer
Dim frmla As String, sumRange As String, sheets3D As String, sht As String
Dim vCheck As Variant, vCriteria As Variant, vFrmla As Variant, vResults As Variant
Dim wbCheck As Workbook
On Error Resume Next
Set cel = Application.Caller
If cel Is Nothing Then
    SumVals3D = "#NoRange"
    Exit Function
End If

vFrmla = ParseFunction(cel.Cells(1), "SumVals3D")
vCheck = Parse3D(cel.Cells(1), CStr(vFrmla(1)))
Set wbCheck = Workbooks(vCheck(1))
iFirstCheck = wbCheck.Worksheets(vCheck(2)).Index
iLastCheck = wbCheck.Worksheets(vCheck(3)).Index
sheets3D = wbCheck.Worksheets(vCheck(2)).Name & ":" & wbCheck.Worksheets(vCheck(3)).Name

sumRange = vCheck(4)
For k = iFirstCheck To iLastCheck
    sht = wbCheck.Worksheets(k).Name
    Set rg = wbCheck.Worksheets(k).Range(sumRange)
    Set rg = Intersect(wbCheck.Worksheets(k).UsedRange, rg)
    If Not rg Is Nothing Then
        For Each cel In rg.Cells
            vResults = vResults + Val(cel.Value)
    End If
SumVals3D = vResults
End Function

Function ParseFunction(FormulaCell As Range, fnName As String)
'Parses a formula looking for a specified function. If found, returns an array consisting of the function call plus _
    each parameter as a string. If a 3D range is not already surrounded by single quotes, they will be added
'Function tolerates commas in workbook or sheet names, array constants and range unions
'FormulaCell is a range variable pointing to the cell that contains the 3D formula
'fnName is the name of the 3D function, e.g. CountIf3D, SumIf3D, VLookup3D
Dim i As Integer, i1 As Integer, iParm As Integer, j As Integer, k As Integer, n As Integer, parmStart As Integer
Dim frmla As String, sParm As String, s1 As String
Dim vParms As Variant
Dim b3D As Boolean, bText As Boolean
ReDim vParms(30)
frmla = FormulaCell.Formula
j = InStr(1, UCase(frmla), UCase(fnName) & "(")
If j > 0 Then
    frmla = Mid(frmla, j)
    i1 = InStr(1, frmla, "(")
    k = 1
    n = Len(frmla)
    parmStart = i1 + 1
    For i = i1 + 1 To n
        s1 = Mid(frmla, i, 1)
        Select Case s1
        Case "'"    'Ignore parentheses and commas inside paired single quotes
            b3D = Not b3D
        Case """"   'Ignore parentheses and commas inside paired double quotes
            bText = Not bText
        Case ","
            If (b3D = False) And (bText = False) And (k = 1) Then
                iParm = iParm + 1
                vParms(iParm) = Mid(frmla, parmStart, i - parmStart)
                parmStart = i + 1
            End If
        Case "(", "{"
            If (b3D = False) And (bText = False) Then k = k + 1     'Increase parenthetical level
        Case "}"
            If (b3D = False) And (bText = False) Then k = k - 1     'Decrease parenthetical level
        Case ")"
            If (b3D = False) And (bText = False) Then k = k - 1     'Decrease parenthetical level
            If k = 0 Then
                vParms(0) = Left(frmla, i)
                iParm = iParm + 1
                vParms(iParm) = Mid(frmla, parmStart, i - parmStart)
                ReDim Preserve vParms(iParm)
                ParseFunction = vParms
                Exit For
            End If
        End Select
End If
End Function

Function Parse3D(rgFormulaCell As Range, sParameter As String) As Variant
'Parses a 3D parameter and returns a variant array containing four strings: _
    workbook name, first worksheet name, last worksheet name and range address. _
    Function tolerates commas in workbook or sheet names, array constants and range unions
'rgFormulaCell is the cell containing the formula with the parameter
'sParameter is the text of the parameter
Dim j As Integer, k As Integer
Dim firstSheet As String, lastSheet As String, sPath As String, sRange As String, _
    sSeparator As String, sSheets As String, sWorkbook As String
Dim nm As Name
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
sSeparator = ","        'The .Formula property uses a comma as list separator, no matter what the regional setting
sPath = ""
sSheets = Replace(sParameter, "''", "'")
sSheets = Replace(sSheets, """""", """")
    'Test whether parameter is a named range
On Error Resume Next
Set nm = rgFormulaCell.Parent.Names(sSheets)
If nm Is Nothing Then Set nm = rgFormulaCell.Parent.Parent.Names(sSheets)
On Error GoTo 0
If Not nm Is Nothing Then sSheets = Mid(nm.RefersTo, 2)     'Delete the initial = sign

k = InStrRev(sSheets, "!")
If k = 0 Then
    sRange = sSheets
    firstSheet = rgFormulaCell.Worksheet.Name
    lastSheet = rgFormulaCell.Worksheet.Name
    sRange = Mid(sSheets, k + 1)
    sSheets = Left(sSheets, k - 1)
    k = InStr(1, sSheets, "]")
    If k > 0 Then
        sWorkbook = Split(sSheets, "]")(0)
        sSheets = Split(sSheets, "]")(1)
        If Left(sWorkbook, 1) = "'" Then sWorkbook = Mid(sWorkbook, 2)
        j = InStr(1, sWorkbook, "[")
        If j > 1 Then sPath = Left(sWorkbook, j - 1)
        If j > 0 Then sWorkbook = Mid(sWorkbook, j + 1)
    End If
    If Left(sSheets, 1) = "'" Then sSheets = Mid(sSheets, 2)
    If Right(sSheets, 1) = "'" Then sSheets = Left(sSheets, Len(sSheets) - 1)
    k = InStr(1, sSheets, ":")
    If k = 0 Then
        firstSheet = sSheets
        lastSheet = sSheets
        firstSheet = Split(sSheets, ":")(0)
        lastSheet = Split(sSheets, ":")(1)
    End If
End If
If sWorkbook = "" Then sWorkbook = rgFormulaCell.Worksheet.Parent.Name
Parse3D = Array(sPath, sWorkbook, firstSheet, lastSheet, sRange)
End Function

Open in new window

dgd1212Author Commented:
Follow up question regarding this:
=SUM(SUBSTITUTE(INDIRECT("Sheet"&ROW()&"!A1")," ft.","")) (and the other two)

If the tabs are not named "Sheet" but various other names, is there a work around?

I should have clarified that originally. In the VBA window (Alt-F11) I was thinking that sheet there and not the tab name, which is different.
you coudl try the following simple UDF:
Function sumFt(cellAddress As String, unit As String) As Double

For Each sht In ThisWorkbook.Sheets
    If sht.Range(cellAddress).Value Like "*" & unit Then
        cellValue = 0
        On Error Resume Next
        cellValue = Trim(Replace(sht.Range(cellAddress).Value, unit, ""))
        sumFt = sumFt + cellValue
    End If
Next sht

End Function

Open in new window

Formula use:
=sumFt("A1"," ft.")
=sumFt([cell reference],[text to remove])

(both values should be between quotes)

This will cycle through all sheets and look in "A1" for values with " ft."
The file attached has the example.
The formula cannot go in cell A1 as it will error with a circular ref.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
byundtMechanical EngineerCommented:
The complicated-seeming code that I suggested has as its guiding principle the ability to pass a true 3D range of cells. This means that formulas using SumVals3D will respond when required, and only when required.

Previously, I wrote a number of "quick and dirty" user defined functions (UDFs) that simulate processing of a 3D range by passing it as text. I was never happy with such code because formulas either wouldn't update when they needed to or because they were updating when they didn't need to (i.e. whenever anything changed in any open workbook).

Benefits of passing a true 3D range to the UDF include:
When the value of one of the cells within the 3D range changes, the formula updates
If you insert or delete a worksheet within that 3D range, the formula updates
If you change a value anywhere else in the workbook, the formula neither needs to recalculate, nor does it do so
It adds up values only within the desired range of worksheets. Exceptions do not need to be hard-coded in the UDF. I find it convenient to insert blank worksheets named First and Last into my workbook to mark the beginning and end of the 3D range. Any worksheet you insert between First and Last will be included in 3D formulas, including those using my suite of 3D UDFs.
Though not required by your specific problem, SumVals3D is smart enough to search only those cells within the used range of each worksheet. You can add up values within an entire column without the agonizing delay to check over a million cells on each worksheet.

Open in new window

The reason the code is so complicated is that while you can pass a 3D range to VBA, a runtime error results whenever the code tries to access that 3D range. My workaround for that problem is to capture the text of the worksheet formula using my 3D function. The code then parses that text, and figures out the details of which cells the 3D range refers to.
byundtMechanical EngineerCommented:
If you are willing to use a Custom number format with a number followed by "ft" like suggested by Wayne Taylor, then you can automate creating and applying such a number format with the macro shown below.

The macro will ask you to pick cells marking the top left and bottom right cells in the 3D range. If a cell has a non-zero numeric value (possibly followed by text) within that 3D range. Those cells will receive the Custom format and their value will be converted from text to a number. Cells that do not contain a numeric value will not be converted.

After using the macro, you can then use a worksheet formula like:

The macro does not need to be in the same workbook as you are editing, so you could keep it in your Personal.xlsm if desired. Nor will you need to attach any VBA code to the finished workbook (i.e. after you have run the macro).
'Put this code in a regular module sheet
Sub FtNumberFormat()
Dim cel As Range, celFirst As Range, celLast As Range, rg As Range
Dim i As Long, n As Long
Dim ws As Worksheet
Dim addr As String
Set celFirst = _
    Application.InputBox("Please pick top left cell in range of first worksheet to be formatted", "Format cells with 'ft' number format", Type:=8)
If Not celFirst Is Nothing Then Set celLast = _
    Application.InputBox("Please pick bottom right cell in range of last worksheet to be formatted", "Format cells with 'ft' number format", Type:=8)
If Not celLast Is Nothing And (celFirst.Worksheet.Parent Is celLast.Worksheet.Parent) Then
    n = celLast.Worksheet.Index
    addr = celFirst.Cells(1, 1).Address & ":" & celLast.Cells(1, 1).Address
    With celFirst.Worksheet.Parent
        For i = celFirst.Worksheet.Index To n
            Set ws = .Worksheets(i)
            Set rg = ws.Range(addr)
            Set rg = Intersect(rg, ws.UsedRange)
            rg.NumberFormat = "# \f\t;-# \f\t;\-;@"
            For Each cel In rg.Cells
                If Val(cel.Value) <> 0 Then cel.Value = Val(cel.Value)
    End With
End If
End Sub

Open in new window

dgd1212Author Commented:
This solution provided needed result, especially for other team members who do not use Excel that extensively. Thank You!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.