Can't figure it out

[black02ss]

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

[Andy Pope]

Hi black02ss,

ectval is not declared or assigned so getcola is zero all the time.

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

Try adding Option Explicit to the top of your code module.
Sort out the compile errors and see if the problem persists.

[black02ss]

Ok Thanks, The ectval should be mafval, But I am still not getting any results. Where do I need to put Option Explicit? Which Code Module?

[Andy Pope]

In the example you posted that would be Module1. Before the line

'set some constants - these are the heading we're looking for

[Paleo]

Option Explicit should be the first line in the module.

[black02ss]

OK, now it is telling me that in this sub, "acol =" Variable not defined.

Sub AnalyzeData5()
'On Error GoTo NoData:
Dim arrVals(1 To 1, 1 To 85) As Single 'array to hold accumalated values
Dim arrCount(1 To 1, 1 To 85) As Single 'array to hold count of values
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
acol = getcolA(cell.Offset(0, OffMAF).Value)

Variable Not Defined

[Andy Pope]

Check out routine getrow1() as it returns zero.
The input value is the contents of column N on the data sheet, which has values in the 10's not >= 1500 And <= 12000

Yep, Option Explicit will make you declare all your variables.
Might seems like a pain to start with BUT it will stop silly typo errors

[black02ss]

I guess I am not following you. Column N (Dyn Air) should be plotted from B15:CH15 on the MAF Sheet accodring to column F (MAF Hz). Does that make sense?

[Andy Pope]

I will check later tonight, need to travel home now, but in the meantime use the code for getrow1().
You should the at least get output on the MAF sheet.

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
If getrow1 = 0 Then getrow1 = 1
End Function

[black02ss]

Appreciate it. Tried and still having the same problems.

[Anne Troy]

(code tags changed to vba tags in Andy's post)

[black02ss]

Got it!!

[Andy Pope]

Hi black02ss,

I'm glad you have but what exactly did you get?


And Dreamboat thanks for amending my tags. I see using VBA adds some colour to the dull old Code tag

[black02ss]

It appears that the sheet now works properly. There is one more thing that I would like to add but can't find any the correct way to do it. I would like to add a macro that removes rows according to values in a certain column, by header name. I will enclose my latest sheet to show what I am doing. I am sure the coding can be done more efficently, but this is the only way I know how to make it work.

[Andy Pope]

Sorry, I can't tell from your latest posting what rows your want to delete and on which sheet.

[black02ss]

If column RPM <= 0 I want that row deleted.

[Andy Pope]

Hi,

Try this. Although your latest example workbook does not contain any rows where the RPM is less than or equal to zero.

Sub DeleteRPM()
Dim lngCol As Long
    Dim lngRow As Long
Set RawDataSheet = ThisWorkbook.Sheets("Data")
    'set a reference to the complete data range
    Set DataRange = RawDataSheet.Cells(1, 1).CurrentRegion
'search for the headings
    With DataRange
    'first set the LTITGEAR range
        For lngCol = 1 To .Columns.Count
            If .Cells(1, lngCol).Value = RPMHeading Then
                Set rngRPM = .Range(Cells(2, lngCol), Cells(.Rows.Count, lngCol))
                Exit For
            End If
        Next
    End With
For lngRow = rngRPM.Rows.Count To 1 Step -1
        If rngRPM.Cells(lngRow, 1) <= 0 Then
            rngRPM.Rows(lngRow).Delete
        End If
    Next
End Sub

[black02ss]

Ok Andy, thanks a bunch. Here is a question now. If I run the macro from the sheet "Data", it works great. I have another macro that houses other functions as well. When I put the DeleteRPM function in that, it still works, but the results are different. It gives me two blank rows of data at rows 9 and 10.

Sub RAF()
DeleteRPM
Macro1
Init5
AnalyzeData5
Init6
AnalyzeData6
Init7
AnalyzeData7
CleanUp
End Sub

I am trying to ask broad questions and figure things out on my own so I can learn, but I guess it just working. I thought that if I could get the code to delete the rows for RPM then I code alter it to delete others as well. If I wanted to delete rows based on more then one column, could I use one Sub instead of several? Basically here is a general idea of what I am trying to do. Originally I couldn't run your sub from any worksheet so I changed it to go to the DATA page.. It works, but I don't know if I did it right..

Sub DeleteRPM()
Sheets("Data").Select 'this is what I added
Dim lngCol As Long
Dim lngRow As Long
Set RawDataSheet = ThisWorkbook.Sheets("Data")
'set a reference to the complete data range
Set DataRange = RawDataSheet.Cells(1, 1).CurrentRegion
'search for the headings
With DataRange
'first set the LTITGEAR range
For lngCol = 1 To .Columns.Count
If .Cells(1, lngCol).Value = RPMHeading Then
Set rngRPM = .Range(Cells(2, lngCol), Cells(.Rows.Count, lngCol))
Exit For
End If
Next
End With
For lngRow = rngRPM.Rows.Count To 1 Step -1
If rngRPM.Cells(lngRow, 1) <= 499 Then ' altered this to reflect 499 instead of 0
rngRPM.Rows(lngRow).Delete
End If
Next
End Sub

if RPM <=499 (I originally said 0 but have changed my mind, I already altered the code for that.
if MAF <=1499

I need these to be separate and not dependent on another. So if the values of rpm are 800 and the MAF is 1200, it still deletes that row. Make any sense?

I appreciate your help on this as I have searched and can't seem to find what I am looking for. I am learning as I go.

Ok here is the new code I just tried and it seems to work. I still have blank rows at 9-10 when ran from the sub (RAF), but if I run it from the Data sheet, I don't.

Sub DeleteRPM()
Sheets("Data").Select
Dim lngCol As Long
Dim lngRow As Long
Set RawDataSheet = ThisWorkbook.Sheets("Data")
'set a reference to the complete data range
Set DataRange = RawDataSheet.Cells(1, 1).CurrentRegion
'search for the headings
With DataRange
'first set the LTITGEAR range
For lngCol = 1 To .Columns.Count
If .Cells(1, lngCol).Value = RPMHeading Then
Set rngRPM = .Range(Cells(2, lngCol), Cells(.Rows.Count, lngCol))
Exit For
End If
Next
End With
For lngRow = rngRPM.Rows.Count To 1 Step -1
If rngRPM.Cells(lngRow, 1) <= 499 Then
rngRPM.Rows(lngRow).Delete
End If
Next
With DataRange
'first set the LTITGEAR range
For lngCol = 1 To .Columns.Count
If .Cells(1, lngCol).Value = MAFHeading Then
Set rngMAF = .Range(Cells(2, lngCol), Cells(.Rows.Count, lngCol))
Exit For
End If
Next
End With
For lngRow = rngMAF.Rows.Count To 1 Step -1
If rngMAF.Cells(lngRow, 1) <= 1499 Then
rngMAF.Rows(lngRow).Delete
End If
Next
End Sub

[Andy Pope]

First of a correction to the DeleteRPM routine to delete the entire row not just the contents of the RPM column.
Note this is not generating the problem with the 2 blank rows.

For lngRow = rngRPM.Rows.Count To 1 Step -1
        If rngRPM.Cells(lngRow, 1) <= 499 Then ' altered this to reflect 499 instead of 0
            rngRPM.Rows(lngRow).EntireRow.Delete
        End If
    Next

The blank rows are created by this routine. But I don't kwno what this is suppose to be doing.

Sub Macro1()
' Macro1 Macro
' Macro recorded 3/13/2005 by Chad Rose
Range("B9:Q10").Select
    Range("B9").Activate
    Range("B9:Q10,AO19:BD20,AO23:BD23").Select
    Range("AO23").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B3").Select
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "=R[-6]C+R[15]C[39]"
    Range("B10").Select
    Selection.Copy
    Range("C10:Q10").Select
    ActiveSheet.Paste
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "=R[-6]C+R[13]C[39]"
    Range("B9").Select
    Selection.Copy
    Range("C9:Q9").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-6]C+R[13]C[39]"
    Range("B9:Q10").Select
    Range("B9").Activate
' this clears the contents
    Range("B9:Q10,AO19:BD20,AO23:BD23").Select
    Range("AO23").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B3").Select
End Sub