black02ss
03-14-2005, 09:05 AM
I don't see any errors in the code, but when I run it, I don't receive any data. I got it to work with other headers and values, but when I try it with these, nothing happens.. Any Ideas?
'set some constants - these are the heading we're looking for
Const LTFT1Heading As String = "Long Term Fuel Trim Bank 1 (SAE) %"
Const LTFT2Heading As String = "Long Term Fuel Trim Bank 2 (SAE) %"
Const ACTHeading As String = "Air Fuel Ratio Commanded afr"
Const MAFHeading As String = "Mass Air Flow Hz"
Const AIRHeading As String = "Dynamic Airflow lb/min"
Const LTITHeading As String = "LTIT Gear/ACoff lb/min"
Const LTIT1Heading As String = "Idle Adapt (STIT) lb/min"
Const LTIT2Heading As String = "LTIT PN/ACoff lb/min"
Const AFRHeading As String = "Wideband AFR"
Const RPMHeading As String = "Engine RPM (SAE) rpm"
Const MAPHeading As String = "Manifold Absolute Pressure (SAE) kPa"
Const ECTHeading As String = "Engine Coolant Temp (SAE) ?F"
Dim RawDataSheet As Worksheet
Dim DataRange As Range
Dim rngAIR As Range 'Dyn Air Column Number
Dim rngLTFT1 As Range 'LTFT1 column number
Dim rngLTIT As Range 'LTIT column Number
Dim rngltit1 As Range 'LTIT1 Column Number
Dim rngLTIT2 As Range 'LTIT 2 Column Number
Dim rngLTFT2 As Range 'LTFT2 column number
Dim rngACT As Range 'Commanded AFR column number
Dim rngAFR As Range
Dim rngRPM As Range 'rpm column number
Dim OffAIR As Long
Dim OffMAF As Long
Dim OffMAP As Long 'MAP column number
Dim OffECT As Long 'ECT column number
Dim OffRPM As Long 'RPM column number
Dim OutTabHomeCell As Range 'reference cell for output table
Sub MAF()
Init5
AnalyzeData5
CleanUp
End Sub
'LTIT GEAR
Sub Init5()
Dim i As Long
Sheets("Data").Select
'set a reference to the data sheet
Set RawDataSheet = ThisWorkbook.Sheets("Data")
'.Cells(2, 17).Select
'set a reference to the complete data range
RawDataSheet.Cells(1, 1).Activate
Set DataRange = ActiveCell.CurrentRegion
'search for the headings
With DataRange
'first set the LTITGEAR range
For i = 1 To .Columns.Count
If .Cells(1, i).Value = AIRHeading Then
Set rngAIR = .Range(Cells(2, i), Cells(.Rows.Count, i))
End If
'If .Cells(1, i).Value = RPMHeading And .Cells(1, i).Value > 2000 Then
' Set rngLTIT = .Range(Cells(2, i), Cells(.Rows.Count, i))
'End If
Next
'then get the offsets of the MAP abd RPM columns
For i = 1 To .Columns.Count
If .Cells(1, i).Value = MAFHeading Then
OffMAF = i - rngAIR.Column
End If
Next
End With
Set OutTabHomeCell = ActiveWorkbook.Sheets("MAF").Cells(14, 2)
Sheets("MAF").Select
End Sub
'LTIT DATA
Sub AnalyzeData5()
'On Error GoTo NoData:
'array to hold accumalated values
Dim arrVals(1 To 1, 1 To 85) As Single
'array to hold count of values
Dim arrCount(1 To 1, 1 To 85) As Single
Dim cell As Range
Dim r As Long, c As Long
'loop though LTIT range
For Each cell In rngAIR
If cell.Value <> 0 Then 'ignore zero entries
'the next two rows pass a value - (cell.Offset(0, OffMAP).Value)
'- to a function below
'and the function returns which range, or row in the table,
'the value belongs to
'arow = getrow("") 'function to select MAP range
'function to select /ECTRPM range
acol = getcolA(cell.Offset(0, OffMAF).Value)
'function to select MAP range
arow = getrow1(cell.Offset(0).Value)
If acol <> 0 And arow <> 0 Then
'add value to value array slot
arrVals(arow, acol) = arrVals(arow, acol) + cell.Value
'increment counter for array slot
arrCount(arow, acol) = arrCount(arow, acol) + 1
End If
End If
Next
'loop though our output table and arrays,
'average and transfer the values
For c = 1 To 85
For r = 1 To 1
If arrCount(r, c) <> 0 Then
OutTabHomeCell.Offset(r, c).Value = arrVals(r, c) / arrCount(r, c)
End If
Next
Next
'On Error GoTo 0
'Exit Sub
' MsgBox "There is no Correct MAF Data Present,
'Please double check your headers and log file."
Range("c3").Select
End Sub
Function getcolA(MAFval As Single) As Integer
For i = 1 To 85
If ectval >= 1500 + (125 * (i - 1)) And MAFval <= 1625 + (125 * (i - 1)) Then
getcolA = i
Exit For
End If
Next
End Function
Function getrow1(MAFval As Single) As Integer
'we need to find which MAP range the value falls into.
'if it were 13 to 17 it would be row 1 of the table
'if it were 18 to 23 it would be row 2 of the table
'etc... etc...
'we know the difference between the startof each range is 5
'and we have 19 ranges corresponding to 19 rows in the final table
'so we can make a loop that checks the first rows, if no match
'go to the next row (i) and add the difference (5) to the start/end of the
'range and check again. When it gets a match, it exits and passes that value
'back up to where it was called from
If MAFval >= 1500 And MAFval <= 12000 Then
getrow1 = 1
End If
End Function
Sub CleanUp()
Set rngLTFT2 = Nothing
Set DataRange = Nothing
Set OutTabHomeCell = Nothing
Set RawDataSheet = Nothing
Set rngLTFT1 = Nothing
Set rngLTIT = Nothing
Set rngAFR = Nothing
Set rngECT = Nothing
Set rngDYN = Nothing
End Sub
'set some constants - these are the heading we're looking for
Const LTFT1Heading As String = "Long Term Fuel Trim Bank 1 (SAE) %"
Const LTFT2Heading As String = "Long Term Fuel Trim Bank 2 (SAE) %"
Const ACTHeading As String = "Air Fuel Ratio Commanded afr"
Const MAFHeading As String = "Mass Air Flow Hz"
Const AIRHeading As String = "Dynamic Airflow lb/min"
Const LTITHeading As String = "LTIT Gear/ACoff lb/min"
Const LTIT1Heading As String = "Idle Adapt (STIT) lb/min"
Const LTIT2Heading As String = "LTIT PN/ACoff lb/min"
Const AFRHeading As String = "Wideband AFR"
Const RPMHeading As String = "Engine RPM (SAE) rpm"
Const MAPHeading As String = "Manifold Absolute Pressure (SAE) kPa"
Const ECTHeading As String = "Engine Coolant Temp (SAE) ?F"
Dim RawDataSheet As Worksheet
Dim DataRange As Range
Dim rngAIR As Range 'Dyn Air Column Number
Dim rngLTFT1 As Range 'LTFT1 column number
Dim rngLTIT As Range 'LTIT column Number
Dim rngltit1 As Range 'LTIT1 Column Number
Dim rngLTIT2 As Range 'LTIT 2 Column Number
Dim rngLTFT2 As Range 'LTFT2 column number
Dim rngACT As Range 'Commanded AFR column number
Dim rngAFR As Range
Dim rngRPM As Range 'rpm column number
Dim OffAIR As Long
Dim OffMAF As Long
Dim OffMAP As Long 'MAP column number
Dim OffECT As Long 'ECT column number
Dim OffRPM As Long 'RPM column number
Dim OutTabHomeCell As Range 'reference cell for output table
Sub MAF()
Init5
AnalyzeData5
CleanUp
End Sub
'LTIT GEAR
Sub Init5()
Dim i As Long
Sheets("Data").Select
'set a reference to the data sheet
Set RawDataSheet = ThisWorkbook.Sheets("Data")
'.Cells(2, 17).Select
'set a reference to the complete data range
RawDataSheet.Cells(1, 1).Activate
Set DataRange = ActiveCell.CurrentRegion
'search for the headings
With DataRange
'first set the LTITGEAR range
For i = 1 To .Columns.Count
If .Cells(1, i).Value = AIRHeading Then
Set rngAIR = .Range(Cells(2, i), Cells(.Rows.Count, i))
End If
'If .Cells(1, i).Value = RPMHeading And .Cells(1, i).Value > 2000 Then
' Set rngLTIT = .Range(Cells(2, i), Cells(.Rows.Count, i))
'End If
Next
'then get the offsets of the MAP abd RPM columns
For i = 1 To .Columns.Count
If .Cells(1, i).Value = MAFHeading Then
OffMAF = i - rngAIR.Column
End If
Next
End With
Set OutTabHomeCell = ActiveWorkbook.Sheets("MAF").Cells(14, 2)
Sheets("MAF").Select
End Sub
'LTIT DATA
Sub AnalyzeData5()
'On Error GoTo NoData:
'array to hold accumalated values
Dim arrVals(1 To 1, 1 To 85) As Single
'array to hold count of values
Dim arrCount(1 To 1, 1 To 85) As Single
Dim cell As Range
Dim r As Long, c As Long
'loop though LTIT range
For Each cell In rngAIR
If cell.Value <> 0 Then 'ignore zero entries
'the next two rows pass a value - (cell.Offset(0, OffMAP).Value)
'- to a function below
'and the function returns which range, or row in the table,
'the value belongs to
'arow = getrow("") 'function to select MAP range
'function to select /ECTRPM range
acol = getcolA(cell.Offset(0, OffMAF).Value)
'function to select MAP range
arow = getrow1(cell.Offset(0).Value)
If acol <> 0 And arow <> 0 Then
'add value to value array slot
arrVals(arow, acol) = arrVals(arow, acol) + cell.Value
'increment counter for array slot
arrCount(arow, acol) = arrCount(arow, acol) + 1
End If
End If
Next
'loop though our output table and arrays,
'average and transfer the values
For c = 1 To 85
For r = 1 To 1
If arrCount(r, c) <> 0 Then
OutTabHomeCell.Offset(r, c).Value = arrVals(r, c) / arrCount(r, c)
End If
Next
Next
'On Error GoTo 0
'Exit Sub
' MsgBox "There is no Correct MAF Data Present,
'Please double check your headers and log file."
Range("c3").Select
End Sub
Function getcolA(MAFval As Single) As Integer
For i = 1 To 85
If ectval >= 1500 + (125 * (i - 1)) And MAFval <= 1625 + (125 * (i - 1)) Then
getcolA = i
Exit For
End If
Next
End Function
Function getrow1(MAFval As Single) As Integer
'we need to find which MAP range the value falls into.
'if it were 13 to 17 it would be row 1 of the table
'if it were 18 to 23 it would be row 2 of the table
'etc... etc...
'we know the difference between the startof each range is 5
'and we have 19 ranges corresponding to 19 rows in the final table
'so we can make a loop that checks the first rows, if no match
'go to the next row (i) and add the difference (5) to the start/end of the
'range and check again. When it gets a match, it exits and passes that value
'back up to where it was called from
If MAFval >= 1500 And MAFval <= 12000 Then
getrow1 = 1
End If
End Function
Sub CleanUp()
Set rngLTFT2 = Nothing
Set DataRange = Nothing
Set OutTabHomeCell = Nothing
Set RawDataSheet = Nothing
Set rngLTFT1 = Nothing
Set rngLTIT = Nothing
Set rngAFR = Nothing
Set rngECT = Nothing
Set rngDYN = Nothing
End Sub