none
Type Mismatch...Somebody Save Me! RRS feed

  • 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

    Friday, August 14, 2015 7:02 PM

Answers

  • 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



    • Edited by James Cone Saturday, August 15, 2015 6:13 PM
    • Marked as answer by Gradient127 Monday, August 17, 2015 12:54 PM
    Saturday, August 15, 2015 5:59 PM

All replies

  • 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



    • Edited by James Cone Saturday, August 15, 2015 6:13 PM
    • Marked as answer by Gradient127 Monday, August 17, 2015 12:54 PM
    Saturday, August 15, 2015 5:59 PM
  • Excellent! Thank you so much!! Really appreciated.
    Monday, August 17, 2015 12:58 PM