black02ss
03-13-2005, 12:57 AM
Sorry if this is long. This was done for me and works great, but I want to change one thing. The way it is now, it will return the data into a table such as this... RPM value is up top MAP value is on the left... Data plotted is LTFT1
http://www.vbaexpress.com/EE/before19105.jpg
I want it to leave off the MAP value on the left and only give me the data for RPMS. Such as this..
http://www.vbaexpress.com/EE/after19105.jpg
Sub Init1()
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 LTFT1 range
For i = 1 To .Columns.Count
If .Cells(1, i).Value = LTFT1Heading Then
Set rngLTFT1 = .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 = MAPHeading Then
OffMAP = i - rngLTFT1.Column
ElseIf .Cells(1, i).Value = RPMHeading Then
OffRPM = i - rngLTFT1.Column
End If
Next
End With
'set a reference cell for output table
Set OutTabHomeCell = ActiveWorkbook.Sheets("Outputed Data").Cells(24, 45)
end sub
Sub AnalyzeData1()
On Error GoTo NoData:
Dim arrVals(1 To 19, 1 To 20) As Single 'array to hold accumalated values
Dim arrCount(1 To 19, 1 To 20) As Single 'array to hold count of values
Dim cell As Range
Dim r As Long, c As Long
'loop though LTFT1 range
For Each cell In rngLTFT1
If cell.Value >= -25 And cell.Value <= 25 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(cell.Offset(0, OffMAP).Value) 'function to select MAP range
acol = getcol(cell.Offset(0, OffRPM).Value) 'function to select RPM range
If arow <> 0 And acol <> 0 Then
arrVals(arow, acol) = arrVals(arow, acol) + cell.Value 'add value to value array slot
arrCount(arow, acol) = arrCount(arow, acol) + 1 'increment counter for array slot
End If
End If
Next
'loop though our output table and arrays, average and transfer the values
For c = 1 To 20
For r = 1 To 19
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
NoData:
MsgBox "There is no LTFT Data Present."
Range("c3").Select
End Sub
Function getrow(mapval 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
For i = 1 To 19
If mapval >= 13.5 + (5 * (i - 1)) And mapval <= 17.5 + (5 * (i - 1)) Then
getrow = i
Exit For
End If
Next
End Function
Function getcol(rpmval As Single) As Integer
For i = 1 To 20
If rpmval >= 200 + (400 * (i - 1)) And rpmval <= 600 + (400 * (i - 1)) Then
getcol = i
Exit For
End If
Next
End Function
Again, I have tried to seach but I can't seem to find what I need.. Any help would be appreciated.
http://www.vbaexpress.com/EE/before19105.jpg
I want it to leave off the MAP value on the left and only give me the data for RPMS. Such as this..
http://www.vbaexpress.com/EE/after19105.jpg
Sub Init1()
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 LTFT1 range
For i = 1 To .Columns.Count
If .Cells(1, i).Value = LTFT1Heading Then
Set rngLTFT1 = .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 = MAPHeading Then
OffMAP = i - rngLTFT1.Column
ElseIf .Cells(1, i).Value = RPMHeading Then
OffRPM = i - rngLTFT1.Column
End If
Next
End With
'set a reference cell for output table
Set OutTabHomeCell = ActiveWorkbook.Sheets("Outputed Data").Cells(24, 45)
end sub
Sub AnalyzeData1()
On Error GoTo NoData:
Dim arrVals(1 To 19, 1 To 20) As Single 'array to hold accumalated values
Dim arrCount(1 To 19, 1 To 20) As Single 'array to hold count of values
Dim cell As Range
Dim r As Long, c As Long
'loop though LTFT1 range
For Each cell In rngLTFT1
If cell.Value >= -25 And cell.Value <= 25 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(cell.Offset(0, OffMAP).Value) 'function to select MAP range
acol = getcol(cell.Offset(0, OffRPM).Value) 'function to select RPM range
If arow <> 0 And acol <> 0 Then
arrVals(arow, acol) = arrVals(arow, acol) + cell.Value 'add value to value array slot
arrCount(arow, acol) = arrCount(arow, acol) + 1 'increment counter for array slot
End If
End If
Next
'loop though our output table and arrays, average and transfer the values
For c = 1 To 20
For r = 1 To 19
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
NoData:
MsgBox "There is no LTFT Data Present."
Range("c3").Select
End Sub
Function getrow(mapval 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
For i = 1 To 19
If mapval >= 13.5 + (5 * (i - 1)) And mapval <= 17.5 + (5 * (i - 1)) Then
getrow = i
Exit For
End If
Next
End Function
Function getcol(rpmval As Single) As Integer
For i = 1 To 20
If rpmval >= 200 + (400 * (i - 1)) And rpmval <= 600 + (400 * (i - 1)) Then
getcol = i
Exit For
End If
Next
End Function
Again, I have tried to seach but I can't seem to find what I need.. Any help would be appreciated.