Type Mismatch...Somebody Save Me!

Question

I understand this is a long shot, but I am hoping someone out there can help me. I won't bother explaining the purpose of my program as I doubt it will have any bearing on my problem. The program reads data in an Excel worksheet, calculates a bunch of stuff, than outputs all the numbers I need from a function BlackBox into a 2D array. To check my work, I print the results to a worksheet called TemporaryCalc. I keep getting the same Type Mismatch error. I have replicated the general algorithm of what I am trying to do, and it works! But in this program it isn't. I've attached the code below, as well as the data that is to be in an excel Worksheet named Sheet1.

Please bare with me as I am new to programming. I am positive my program is not 100% efficient and I am sure I am lacking etiquette. If you paste the excel data into Sheet1, and copy the code into a module, you should replicate the problem I am having. Fingers crossed someone can help me.

Sub FrequencyILCalculator()

Dim rowcount As Double
Dim ItemArray() As String
Dim DescriptionArray() As String
Dim SoundPressureArray() As Double
Dim Frequency As Double
Dim NCReceiver As Double

'Determine required NC level
NCReceiver = 40

'Determine number of rows of data (i.e. number of sources). -2 removes header
rowcount = Worksheets("Sheet1").Range("E:E").Cells.SpecialCells(xlCellTypeConstants).Count - 2

'Print function for testing purposes
    Sheets.Add.Name = "TemporaryCalc"
    
    'Print headers
    Dim headerrow As Double
    Dim firstrow As Double
    firstrow = 5                     'Specify the first row in the temporary Excel sheet to have the list of organized sources
    lastrow = (rowcount + firstrow) - 1     'Specify the last row in the temporary Excel sheet to have the list of organized sources
    headerrow = firstrow - 2
    
    Worksheets("TemporaryCalc").Cells(headerrow, 2).Value = "Source Name"
    Worksheets("TemporaryCalc").Cells(headerrow, 3).Value = "Description"
    Worksheets("TemporaryCalc").Cells(headerrow, 4).Value = "SPL"
    Worksheets("TemporaryCalc").Cells(headerrow, 5).Value = "Remove A Scale"
    Worksheets("TemporaryCalc").Cells(headerrow, 6).Value = "Rolling Combined"
    Worksheets("TemporaryCalc").Cells(headerrow, 7).Value = "Remainder with NC"
    Worksheets("TemporaryCalc").Cells(headerrow, 8).Value = "Divide Remainder Over Sources"
    Worksheets("TemporaryCalc").Cells(headerrow, 9).Value = "Required IL"

'Determine what frequency is being analyzed
Dim FrequencyArray() As Variant
ReDim FrequencyArray(8)
FrequencyArray = Array(63, 125, 250, 500, 1000, 2000, 4000, 8000)

'Results list inital start point of 0
Dim ResultsLastRow As Double
ResultsLastRow = 0

'ROTATE THROUGH ALL FREQUENCIES FOR ONE RECEPTOR
For T = 0 To 7
    Frequency = FrequencyArray(0)
    
    'Create array to hold column data for specific octave band (-1 to remove extra spot that occurs in an array)
    ReDim ItemArray(rowcount)
    ReDim DescriptionArray(rowcount)
    ReDim SoundPressureArray(rowcount)
    
    'Fill Array
    For i = 0 To rowcount - 1
        ItemArray(i) = Worksheets("Sheet1").Cells(i + 3, 1).Value
        DescriptionArray(i) = Worksheets("Sheet1").Cells(i + 3, 2).Value
        SoundPressureArray(i) = Worksheets("Sheet1").Cells(i + 3, T + 5).Value '**Update!!**
    Next i
    
    'Print unsorted data into TemporaryCalc sheet
    For x = 0 To rowcount - 1
       Worksheets("TemporaryCalc").Cells(x + firstrow, 2).Value = ItemArray(x)
       Worksheets("TemporaryCalc").Cells(x + firstrow, 3).Value = DescriptionArray(x)
       Worksheets("TemporaryCalc").Cells(x + firstrow, 4).Value = SoundPressureArray(x)
    Next x
    
    'Sort the sources from loudest to quietiest for a given frequency
    Dim R As Range
    
    Set R = Range(Worksheets("TemporaryCalc").Cells(firstrow, 2), Worksheets("TemporaryCalc").Cells(lastrow, 4))
    R.Sort Key1:=Range(Worksheets("TemporaryCalc").Cells(firstrow, 4), Worksheets("TemporaryCalc").Cells(lastrow, 4)), Order1:=xlDescending, MatchCase:=False
    
    'Declare Arrays to hold values after the sorting has completed
    Dim SortedItemArray() As String
    Dim SortedDescriptionArray() As String
    Dim SortedSoundPressureArray() As Double
    
    'Size Arrays to hold values after the sorting has completed
    ReDim SortedItemArray(rowcount)
    ReDim SortedDescriptionArray(rowcount)
    ReDim SortedSoundPressureArray(rowcount)
    
    'Fill Arrays to hold values after the sorting has completed
    For i = 0 To rowcount - 1
        SortedItemArray(i) = Worksheets("TemporaryCalc").Cells(i + firstrow, 2).Value
        SortedDescriptionArray(i) = Worksheets("TemporaryCalc").Cells(i + firstrow, 3).Value
        SortedSoundPressureArray(i) = Worksheets("TemporaryCalc").Cells(i + firstrow, 4).Value
    Next i
    
    'Send sorted arrays in the BlackBox for calculation
    Dim Results As Variant
    Results = BlackBox(SortedItemArray, SortedDescriptionArray, SortedSoundPressureArray, rowcount, Frequency, NCReceiver, firstrow, headerrow)
    
    '"Export" results from BlackBox into this module for manipulation
    Dim ResultsRowCount As Double
    ResultsRowCount = Results(0, 3)

    For i = 0 To ResultsRowCount
        Worksheets("TemporaryCalc").Cells(5 + i + ResultsLastRow, 12).Value = Results(i, 0)
        Worksheets("TemporaryCalc").Cells(5 + i + ResultsLastRow, 13).Value = Results(i, 1)
        Worksheets("TemporaryCalc").Cells(5 + i + ResultsLastRow, T + 14).Value = Results(i, 2)
    Next i
    ResultsLastRow = ResultsLastRow + ResultsRowCount
Next T

End Sub

Private Function Sum2dB(a As Double, b As Double)

Sum2dB = 10 * (Log((10 ^ (a / 10)) + (10 ^ (b / 10))) / Log(10))

End Function

Private Function Sub2dB(a As Double, b As Double)

Sub2dB = 10 * (Log((10 ^ (a / 10)) - (10 ^ (b / 10))) / Log(10))

End Function

Private Function Div2dB(a As Double, b As Double)

Div2dB = 10 * (Log((10 ^ (a / 10)) / b) / Log(10))

End Function

Private Function Mul2dB(a As Double, b As Double)

Mul2dB = 10 * (Log((10 ^ (a / 10)) * b) / Log(10))

End Function

Private Function BlackBox(SortedItemArray() As String, SortedDescriptionArray() As String, SortedSoundPressureArray() As Double, rowcount As Double, Frequency As Double, NCReceiver As Double, firstrow As Double, headerrow As Double)

'PRINT HEADERS FOR TEMPORARYCALC WORKSHEET
'Print numbers on the far left side of spreadsheet to number the sources after sorting.
Dim n As Integer
Dim SourceNumberArray() As Double
ReDim SourceNumberArray(rowcount - 1)
n = 1
For i = 0 To rowcount - 1
    SourceNumberArray(i) = n
'    Worksheets("TemporaryCalc").Cells(i + firstrow, 1) = n                                     '**CAN BE DELETED. FOR TEST PRINT**
    n = n + 1
Next i

'Determine A Scale reduction based on frequency
Dim AScaleBand() As Variant
Dim AScaleReduction() As Variant
Dim AScaleValue As Double

AScaleBand = Array(63, 125, 250, 500, 1000, 2000, 4000, 8000)
AScaleReduction = Array(-26.2, -16.1, -8.6, -3.2, 0, 1.2, 1, -1.1)

For i = 0 To 7
    If Frequency = AScaleBand(i) Then
        AScaleValue = AScaleReduction(i)
'        Worksheets("TemporaryCalc").Cells(4, 5).Value = AScaleValue                 '**CAN BE DELETED. FOR TEST PRINT**
    Exit For
    End If
Next i

'REMOVE A SCALE
'Declare Array to hold values after calculation
Dim SPLLinearArray() As Double

'Size Array to hold values after calculation
ReDim SPLLinearArray(rowcount)

'Complete calculation and fill array with results of Sound Pressure (dB)
For i = 0 To rowcount - 1
    SPLLinearArray(i) = SortedSoundPressureArray(i) - AScaleValue
'    Worksheets("TemporaryCalc").Cells(i + firstrow, 5).Value = SPLLinearArray(i)    '**CAN BE DELETED. FOR TEST PRINT**
Next i

'Rolling Combined
Dim RollingCombinedArray() As Double
ReDim RollingCombinedArray(rowcount)

RollingCombinedArray(rowcount - 1) = SPLLinearArray(rowcount - 1)

For i = rowcount - 2 To 0 Step -1
    RollingCombinedArray(i) = Sum2dB(RollingCombinedArray(i + 1), SPLLinearArray(i))
Next i

For i = 0 To rowcount - 1
'    Worksheets("TemporaryCalc").Cells(i + firstrow, 6).Value = RollingCombinedArray(i)  '**CAN BE DELETED. FOR TEST PRINT**
Next i

'NC CURVES
    'Create NC Arrays for searching
Dim NCLevelArray As Variant, NC15Array As Variant, NC20Array As Variant, NC25Array As Variant, NC30Array As Variant, NC35Array As Variant, NC40Array As Variant, NC45Array As Variant, NC50Array As Variant, NC55Array As Variant, NC60Array As Variant, NC65Array As Variant, NC70Array As Variant

NCLevelArray = Array(15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70)
NC15Array = Array(47, 36, 29, 22, 17, 14, 12, 11)
NC20Array = Array(51, 40, 33, 26, 22, 19, 17, 16)
NC25Array = Array(54, 44, 37, 31, 27, 24, 22, 21)
NC30Array = Array(57, 48, 41, 35, 31, 29, 28, 27)
NC35Array = Array(60, 52, 45, 40, 36, 34, 33, 32)
NC40Array = Array(64, 56, 50, 45, 41, 39, 38, 37)
NC45Array = Array(67, 60, 54, 49, 46, 44, 43, 42)
NC50Array = Array(71, 64, 58, 54, 51, 49, 48, 47)
NC55Array = Array(74, 67, 62, 58, 56, 54, 53, 52)
NC60Array = Array(77, 71, 67, 63, 61, 59, 58, 57)
NC65Array = Array(80, 75, 71, 68, 66, 64, 63, 62)
NC70Array = Array(83, 79, 75, 72, 71, 70, 69, 68)

    'Create a 2-D Array to hold the NC Curve Data
Dim NCArray(12, 8) As Integer
For i = 1 To 12                     'Fill first column with NCLevel values
    NCArray(i, 0) = NCLevelArray(i - 1)
Next i

For j = 1 To 8                      'Fill remaining cells with NC curve values per frequency
    NCArray(0, j) = AScaleBand(j - 1)
    NCArray(1, j) = NC15Array(j - 1)
    NCArray(2, j) = NC20Array(j - 1)
    NCArray(3, j) = NC25Array(j - 1)
    NCArray(4, j) = NC30Array(j - 1)
    NCArray(5, j) = NC35Array(j - 1)
    NCArray(6, j) = NC40Array(j - 1)
    NCArray(7, j) = NC45Array(j - 1)
    NCArray(8, j) = NC50Array(j - 1)
    NCArray(9, j) = NC55Array(j - 1)
    NCArray(10, j) = NC60Array(j - 1)
    NCArray(11, j) = NC65Array(j - 1)
    NCArray(12, j) = NC70Array(j - 1)
Next j

    'Find index number in NCArray
Dim NCCriteria As Double

For i = 1 To 12
    If NCArray(i, 0) = NCReceiver Then
        For j = 1 To 8
            If NCArray(0, j) = Frequency Then
                NCCriteria = NCArray(i, j)
'                Worksheets("TemporaryCalc").Cells(headerrow + 1, 7).Value = NCCriteria  '**CAN BE DELETED. FOR TEST PRINT**
            End If
        Next j
    End If
Next i

    'If all sound pressures total less than the NC criteria, there is no need to compute IL. This skips over the rest of the analysis.
If RollingCombinedArray(0) < NCCriteria Then GoTo Line1
                                                                                     '*********************POSSIBLE ERROR. I ADDED AN END IF

'Compute difference between Rolling Combined and NC Level
Dim q As Integer
Dim RollingCombinedNCDiffArray() As Double

ReDim RollingCombinedNCDiffArray(rowcount - 1)

q = rowcount - 1
Do While NCCriteria > RollingCombinedArray(q)
   RollingCombinedNCDiffArray(q) = Sub2dB(NCCriteria, RollingCombinedArray(q))
   q = q - 1
    
   If q < 0 Then
      Exit Do
   End If
Loop

For i = 0 To rowcount - 1
'    Worksheets("TemporaryCalc").Cells(i + firstrow, 7).Value = RollingCombinedNCDiffArray(i)    '**CAN BE DELETED. FOR TEST PRINT**
Next i

'Divide Remainder Over Sources
Dim u As Integer
Dim RemainderOverSourcesArray() As Double

ReDim RemainderOverSourcesArray(rowcount - 1)

u = rowcount - 1
Do While NCCriteria > RollingCombinedArray(u)
    RemainderOverSourcesArray(u) = Div2dB(RollingCombinedNCDiffArray(u), SourceNumberArray(u - 1))
    u = u - 1
  
    If u = 0 Then
       Exit Do
    End If
Loop

For i = 0 To rowcount - 1
'    Worksheets("TemporaryCalc").Cells(i + firstrow, 8).Value = RemainderOverSourcesArray(i)    '**CAN BE DELETED. FOR TEST PRINT**
Next i

'DETERMINE INSERTION LOSS
Dim ILArraySize As Double
Dim ILItemArray() As String
Dim ILDescriptionArray() As String
Dim ILFrequencyArray() As Double

'CASE 1: If all sound pressure levels are above the NC criteria, subtract the difference between each SPL and NC. Reduce NC by the number of sources
If RollingCombinedArray(rowcount - 1) > NCCriteria Then
    ReDim ILItemArray(rowcount)
    ReDim ILDescriptionArray(rowcount)
    ReDim ILFrequencyArray(rowcount)
       
    ILArraySize = rowcount
    For i = 0 To rowcount - 1
        ILFrequencyArray(i) = SPLLinearArray(i) - (NCCriteria - Mul2dB(0, rowcount))
        ILItemArray(i) = SortedItemArray(i)
        ILDescriptionArray(i) = SortedDescriptionArray(i)
    Next i
    
'    For i = 0 To rowcount - 1
'        Worksheets("TemporaryCalc").Cells(i + firstrow, 9).Value = ILFrequencyArray(i)      '**CAN BE DELETED. FOR TEST PRINT**
'    Next i
    
    GoTo Line2
End If


'CASE 2: If top value in Divide Remainder Over Sources is max value
    'Find max value
Dim maxvar As Double
maxvar = RemainderOverSourcesArray(0)

For j = 1 To rowcount - 1
    If RemainderOverSourcesArray(j) > maxvar Then
        maxvar = RemainderOverSourcesArray(j)
    End If
Next j

    'Compute IL
For i = 0 To rowcount - 1
    If RemainderOverSourcesArray(i) = maxvar Then
        
        'Resize the arrays to fit the results
              ILArraySize = i
              ReDim ILItemArray(i)
              ReDim ILDescriptionArray(i)
              ReDim ILFrequencyArray(i)
        
        For j = 0 To ILArraySize - 1
              'Fill arrays with results
              ILItemArray(j) = SortedItemArray(j)
              ILDescriptionArray(j) = SortedDescriptionArray(j)
              ILFrequencyArray(j) = Round(SPLLinearArray(j) - maxvar, 1)
        Next j
        Exit For
    End If
Next i

'For i = 0 To ILArraySize - 1
'    Worksheets("TemporaryCalc").Cells(i + firstrow, 9).Value = ILFrequencyArray(i)      '**CAN BE DELETED. FOR TEST PRINT**
'Next i

Line2: 'From CASE 1: If all sound pressure levels are above the NC criteria, subtract the difference between each SPL and NC. Reduce NC by the number of sources

'Place all results and integers needed into a 2D array. Last column only holds 1 value (ILArraySize)
Dim BlackBoxArray() As Variant
ReDim BlackBoxArray(ILArraySize, 4)

For i = 0 To ILArraySize - 1
    BlackBoxArray(i, 0) = ILItemArray(i)
    BlackBoxArray(i, 1) = ILDescriptionArray(i)
    BlackBoxArray(i, 2) = ILFrequencyArray(i)
Next i

BlackBoxArray(0, 3) = ILArraySize

BlackBox = BlackBoxArray

Line1: 'If all sound pressures total less than the NC criteria, there is no need to compute IL. This skips over the rest of the analysis.

End Function

Excel Data (Sheet1, paste starting in top left corner A1):

Name	Description	Total	31	63	125	250	500	1000	2000	4000	8000
R45_A	POW - Level 02	64	--	29	47	52	60	59	57	51	43
AHU 03	EA	58	--	17	29	43	56	50	49	44	33
AHU 18	EA	58	--	15	42	48	52	53	52	45	35
AHU 08A	EA	56	--	19	41	43	50	52	49	42	34
AHU 08B	EA	56	--	19	41	43	50	52	50	43	35
AHU 03	RA (EA)	54	--	22	34	43	50	49	46	43	38
EF 316	Exhaust Fan	50	--	24	31	41	47	43	40	35	27
AHU 06	EA	45	--	-2	14	32	42	39	38	35	26
AHU 15	EA	43	--	2	25	29	36	39	36	26	15
CT 1	Cooling Tower	34	--	18	22	28	29	27	22	15	5
CT 2	Cooling Tower	34	--	18	22	28	29	27	22	15	5

Answer 1

Re:  "Please bare with me..."

It has been difficult to do that. <grin>

Use   Option Explicit   as the first line in all modules  (above all subs and functions)
Declare all variables at the top of each procedure.  Do not scatter them throughout the code.

Your problem stems from the BlackBox function exiting before it has been assigned a value.
I replaced this ...
   'If all sound pressures total less than the NC criteria, there is no need to compute IL. This skips over the rest of the analysis.
    If RollingCombinedArray(0) < NCCriteria Then GoTo Line1

With this ...
 If RollingCombinedArray(0) < NCCriteria Then
   ReDim BlackBoxArray(rowcount, 4)
   BlackBoxArray(0, 3) = rowcount
   BlackBox = BlackBoxArray
   GoTo Line1
 End If
'---
The above allowed the code to finish.  You can find a better cure I'm sure.

'---
Jim Cone
http://www.5z8.info/turner-diaries.pdf_s8b5kz_nakedgrandmas.jpg

Answer 2

Excellent! Thank you so much!! Really appreciated.