Answered by:
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 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