Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Top 5 recurring text values with count | Excel Discussion (Misc queries) | |||
How do I find minimum duplicated values in a range? | Excel Worksheet Functions | |||
Find minimum value | Excel Worksheet Functions | |||
How to find the minimum value in a database with multiple values . | Excel Discussion (Misc queries) | |||
find result - only for expert | Excel Programming |