find minimum values in recurring ranges--expert
 

I need to create an automated macro to find the minimum values of recurring
row sets with a space in between the sets such as:

Max Distance = 8100
Min Distance = 7900

Time Distance
00:33.1 8075.000
00:32.8 8083.000
00:32.7 8084.000

01:52.3 8878.000
00:33.4 8073.000
00:23.0 6798.000

00:12.2 4478.000
00:33.3 8092.000
00:33.2 8084.000

but these values must meet criteria from the min and max distance column.
Once I find the minimun time, I must take data from the corresponding row and
paste into a formatted worksheet.

Thanks for any help you can provde....you guys are a blessing.

find minimum values in recurring ranges--expert
 

Here is some code that should work for you. I assumed a few things
There are 2 sheets called "This" and "That". This is where you have all of
your raw data. It has the Max Distance in Cell B1 and the Min in B2. The
ranges start at cell A5 and go down from there. When a Min is found it copeis
the 2 cells from "This" sheet to "That" sheet. All of these settings can be
modified pretty easily by looking thorugh the code. I have to take off now
and won't be able to help you any more until tomorrow, if you still need
help...

Option Explicit

Public Sub CopyShortestTimes()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyFrom As Range
Dim rngCopyTo As Range
Dim sngTime As Single
Dim dblMaxDistance As Double
Dim dblMinDistance As Double
Dim dblLastRow As Double
Dim rngRowToCopy As Range

Set wksCopyFrom = Sheets("This")
Set wksCopyTo = Sheets("That")
Set rngCopyFrom = wksCopyFrom.Range("B5")
Set rngCopyTo = wksCopyTo.Range("A2")
dblMaxDistance = wksCopyFrom.Range("B1").Value
dblMinDistance = wksCopyFrom.Range("B2").Value
dblLastRow = wksCopyFrom.Range("A65535").End(xlUp).Row

Do While rngCopyFrom.Row <= dblLastRow
sngTime = 10
Set rngRowToCopy = Nothing
Do While rngCopyFrom.Value < Empty
If rngCopyFrom.Value <= dblMaxDistance And rngCopyFrom.Value =
dblMinDistance Then
If rngCopyFrom.Offset(0, -1).Value < sngTime Then
sngTime = rngCopyFrom.Offset(0, -1).Value
Set rngRowToCopy = Range(rngCopyFrom.Offset(0, -1),
rngCopyFrom)
End If
End If
Set rngCopyFrom = rngCopyFrom.Offset(1, 0)
Loop
If sngTime < 10 Then
rngRowToCopy.Copy rngCopyTo
Set rngCopyTo = rngCopyTo.Offset(1, 0)
End If
Set rngCopyFrom = rngCopyFrom.Offset(1, 0)
Loop
End Sub


HTH
"xadnora" wrote:

I need to create an automated macro to find the minimum values of recurring
row sets with a space in between the sets such as:

Max Distance = 8100
Min Distance = 7900

Time Distance
00:33.1 8075.000
00:32.8 8083.000
00:32.7 8084.000

01:52.3 8878.000
00:33.4 8073.000
00:23.0 6798.000

00:12.2 4478.000
00:33.3 8092.000
00:33.2 8084.000

but these values must meet criteria from the min and max distance column.
Once I find the minimun time, I must take data from the corresponding row and
paste into a formatted worksheet.

Thanks for any help you can provde....you guys are a blessing.

find minimum values in recurring ranges--expert
 

This is the edited version of your code that I have created but I am still
having problems. I'm not sure if the time format is creating a problem or
not. The time is in mm.ss.0 format but I have changed it to ss.0 with no
luck either. I have 14 columns in between the laptimes and distance columns
that should be copied....not necessarilty the whole row. That is my fault
for not being very clear. They are in the same order when pasted to the
MinMax sheet but in different locations. Thank you for your assistance.

Public Sub CopyShortestTimes()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyFrom As Range
Dim rngCopyTo As Range
Dim sngTime As Single
Dim dblMaxDistance As Double
Dim dblMinDistance As Double
Dim dblLastRow As Double
Dim rngRowToCopy As Range

Set wksCopyFrom = Sheets("Raw Data")
Set wksCopyTo = Sheets("MinMax")
Set rngCopyFrom = wksCopyFrom.Range("D7")
Set rngCopyTo = wksCopyTo.Range("Q11")
dblMaxDistance = wksCopyFrom.Range("H2").Value
dblMinDistance = wksCopyFrom.Range("G2").Value
dblLastRow = wksCopyFrom.Range("A65535").End(xlUp).Row

Do While rngCopyFrom.Row <= dblLastRow
sngTime = 99.99
Set rngRowToCopy = Nothing
Do While rngCopyFrom.Value < Empty
If rngCopyFrom.Value <= dblMaxDistance And rngCopyFrom.Value =
dblMinDistance Then
If rngCopyFrom.Offset(0, -1).Value < sngTime Then
sngTime = rngCopyFrom.Offset(0, -1).Value
Set rngRowToCopy = Range(rngCopyFrom.Offset(0, -1),
rngCopyFrom)
End If
End If
Set rngCopyFrom = rngCopyFrom.Offset(1, 0)
Loop
If sngTime < 99.99 Then
rngRowToCopy.Copy rngCopyTo
Set rngCopyTo = rngCopyTo.Offset(1, 0)
End If
Set rngCopyFrom = rngCopyFrom.Offset(1, 0)
Loop
End Sub


"Jim Thomlinson" wrote:

Here is some code that should work for you. I assumed a few things
There are 2 sheets called "This" and "That". This is where you have all of
your raw data. It has the Max Distance in Cell B1 and the Min in B2. The
ranges start at cell A5 and go down from there. When a Min is found it copeis
the 2 cells from "This" sheet to "That" sheet. All of these settings can be
modified pretty easily by looking thorugh the code. I have to take off now
and won't be able to help you any more until tomorrow, if you still need
help...

Option Explicit

Public Sub CopyShortestTimes()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyFrom As Range
Dim rngCopyTo As Range
Dim sngTime As Single
Dim dblMaxDistance As Double
Dim dblMinDistance As Double
Dim dblLastRow As Double
Dim rngRowToCopy As Range

Set wksCopyFrom = Sheets("This")
Set wksCopyTo = Sheets("That")
Set rngCopyFrom = wksCopyFrom.Range("B5")
Set rngCopyTo = wksCopyTo.Range("A2")
dblMaxDistance = wksCopyFrom.Range("B1").Value
dblMinDistance = wksCopyFrom.Range("B2").Value
dblLastRow = wksCopyFrom.Range("A65535").End(xlUp).Row

Do While rngCopyFrom.Row <= dblLastRow
sngTime = 10
Set rngRowToCopy = Nothing
Do While rngCopyFrom.Value < Empty
If rngCopyFrom.Value <= dblMaxDistance And rngCopyFrom.Value =
dblMinDistance Then
If rngCopyFrom.Offset(0, -1).Value < sngTime Then
sngTime = rngCopyFrom.Offset(0, -1).Value
Set rngRowToCopy = Range(rngCopyFrom.Offset(0, -1),
rngCopyFrom)
End If
End If
Set rngCopyFrom = rngCopyFrom.Offset(1, 0)
Loop
If sngTime < 10 Then
rngRowToCopy.Copy rngCopyTo
Set rngCopyTo = rngCopyTo.Offset(1, 0)
End If
Set rngCopyFrom = rngCopyFrom.Offset(1, 0)
Loop
End Sub


HTH
"xadnora" wrote:

I need to create an automated macro to find the minimum values of recurring
row sets with a space in between the sets such as:

Max Distance = 8100
Min Distance = 7900

Time Distance
00:33.1 8075.000
00:32.8 8083.000
00:32.7 8084.000

01:52.3 8878.000
00:33.4 8073.000
00:23.0 6798.000

00:12.2 4478.000
00:33.3 8092.000
00:33.2 8084.000

but these values must meet criteria from the min and max distance column.
Once I find the minimun time, I must take data from the corresponding row and
paste into a formatted worksheet.

Thanks for any help you can provde....you guys are a blessing.