vba code

Haydo

Board Regular
Joined
Sep 5, 2011
Messages
95
With the code below, the results for Q and H are separately sent to 2 new sheets.

How can i get this code to send both Q and H results to just 1 new sheet, to appear in columns A and B, with a few blank rows separating both results?

Is there a way to write this code more efficiently?

Thanks




Code:
Private Sub CommandButton1_Click()
Dim sheetNum, i, row As Integer
    Dim r, time As Range
    Dim tmp As Variant
    sheetNum = ThisWorkbook.Worksheets.Count
    If sheetNum = 1 Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        Sheets.Add After:=Worksheets(Worksheets.Count)
    ElseIf sheetNum = 2 Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
    End If
    Worksheets(1).Name = "test sheet"
    Worksheets(2).Name = "Fastest Q"
    Worksheets(3).Name = "Fastest H"
    Set r = Worksheets(1).UsedRange
    Set time = r.Columns(17)
    tmp = time.Value
    For i = 1 To 5
        row = WorksheetFunction.Match(WorksheetFunction.Small(tmp, 1), tmp, 0)
        Worksheets(2).Cells(i, 1).Value = Worksheets(1).Cells(row, 3).Value
        Worksheets(2).Cells(i, 2).Value = Worksheets(1).Cells(row, 17).Value
        tmp(row, 1) = WorksheetFunction.Max(tmp)
    Next i
    
    Set time = r.Columns(8)
    tmp = time.Value
    For i = 1 To 5
        row = WorksheetFunction.Match(WorksheetFunction.Small(tmp, 1), tmp, 0)
        Worksheets(3).Cells(i, 1).Value = Worksheets(1).Cells(row, 3).Value
        Worksheets(3).Cells(i, 2).Value = Worksheets(1).Cells(row, 8).Value
        tmp(row, 1) = WorksheetFunction.Max(tmp)
    Next i
End Sub
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,251
Office Version
  1. 2013
Platform
  1. Windows
Please just tell us in words what your wanting to do here.
Lets not talk about this code. Just tell us in detail what your attempting to do.
 

Haydo

Board Regular
Joined
Sep 5, 2011
Messages
95
This code works well. I just need a small change to it.

There are hundreds of rows on the sheet i am working from called 'test sheet'

It takes the 5 lowest numbers (each number has decimal places) from columns Q and H, and takes the corresponding entry (name) from Column C and creates a new sheet for each result of Q and H

Q sheet result looks like this format
brad 23.18
steve 23.28
tom 24.24
Ian 24.58
Con 24.98


H sheet result looks like this
Maddy 13.23
Sarah 13.58
Missy 13.98
Zoe 14.54
Lily 14.89

So currently there are 2 new sheets being created, each with 5 rows and 2 columns

I would there to be only one sheet, with 2 rows separating each 5 row result

It would look like this..
brad 23.18
steve 23.28
tom 24.24
Ian 24.58
Con 24.98


Maddy 13.23
Sarah 13.58
Missy 13.98
Zoe 14.54
Lily 14.89

thanks in advance
 
Last edited:

tonyyy

Well-known Member
Joined
Jun 24, 2015
Messages
1,647
Haydo,

The following is untested, but you might give it a try...

Code:
Private Sub CommandButton1_Click()
Dim sheetNum As Integer, i As Integer, row As Integer
Dim r As Range, time As Range
Dim tmp As Variant

sheetNum = ThisWorkbook.Worksheets.Count
If sheetNum = 1 Then Sheets.Add After:=Worksheets(Worksheets.Count)

Worksheets(1).Name = "test sheet"
Worksheets(2).Name = "Fastest QandH"
Set r = Worksheets(1).UsedRange

Set time = r.Columns(17)
tmp = time.Value
For i = 1 To 5
    row = WorksheetFunction.Match(WorksheetFunction.Small(tmp, 1), tmp, 0)
    Worksheets(2).Cells(i, 1).Value = Worksheets(1).Cells(row, 3).Value
    Worksheets(2).Cells(i, 2).Value = Worksheets(1).Cells(row, 17).Value
    tmp(row, 1) = WorksheetFunction.Max(tmp)
Next i

Set time = r.Columns(8)
tmp = time.Value
For i = 8 To 12
    row = WorksheetFunction.Match(WorksheetFunction.Small(tmp, 1), tmp, 0)
    Worksheets(2).Cells(i, 1).Value = Worksheets(1).Cells(row, 3).Value
    Worksheets(2).Cells(i, 2).Value = Worksheets(1).Cells(row, 8).Value
    tmp(row, 1) = WorksheetFunction.Max(tmp)
Next i
End Sub

Cheers,

tonyyy
 

Watch MrExcel Video

Forum statistics

Threads
1,122,222
Messages
5,594,899
Members
413,950
Latest member
solve22

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top