Create Sheet to index scores for a club

ShiftyThor

New Member
Joined
Mar 4, 2013
Messages
14
Good day All,

I need to extract data from an excel sheet and index them on another sheet to formulate results with handicaps etc. I am struggling on extracting the data:

DivisionStage NumberNameHit Factor
Classic1Ira2.57
Classic2Ira0.97
Standard1Jason5.36
Standard1Troy5.29
Standard1Paul5.18
Standard1Dion2.80
Standard2Dion5.36
Standard2Jason3.67
Standard2Paul3.39
Standard2Troy1.61

<tbody>
</tbody>



















I require the below output from the information above:

NameDivisionStage 1HandicapStage 2Handicap
IraClassic2.57(To be inputted)0.97(To be inputted)
JasonStandard5.36(To be inputted)3.67(To be inputted)
TroyStandard5.29(To be inputted)1.61(To be inputted)
PaulStandard5.18(To be inputted)3.39(To be inputted)
DionStandard2.8(To be inputted)5.36(To be inputted)

<tbody>
</tbody>











Basically this is an extract from a much larger database, we would require the persons names, and stage scores on one row taken from another sheet, and then work out handicaps at the end of the row. I am struggling with the extraction (other than a very long string with if's and else's. I am hoping there is a way with indexing and or matching. After the above is achieved, we can work on the rest of the formulae which is straight forward, and we can add more stages once we see if a formula is made in order for us to carry on.

Thanks in advance.
 

theBardd

Rules violation
Joined
Jan 21, 2012
Messages
912
This should do it

Code:
Public Sub Reformat()
Dim ws As Worksheet
Dim lastrow As Long
Dim nextrow As Long
Dim targetrow As Long
Dim i As Long
    Application.ScreenUpdating = False
    With ActiveSheet
    
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets("Output").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        
        Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        ws.Name = "Output"
        ws.Range("A1:F1").Value = Array("Name", "Division", "Stage 1", "Handicap", "Stage 2", "Handicap")
        
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastrow
        
            targetrow = FindMatch(.Cells(i, "C").Value, ws.Columns(1))
            If targetrow = 0 Then targetrow = Application.CountA(ws.Columns(1)) + 1
            
            ws.Cells(targetrow, "A").Value = .Cells(i, "C").Value
            ws.Cells(targetrow, "B").Value = .Cells(i, "A").Value
            If .Cells(i, "B").Value = 1 Then
            
                ws.Cells(targetrow, "C").Value = .Cells(i, "D").Value
            Else
            
                ws.Cells(targetrow, "E").Value = .Cells(i, "D").Value
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
Private Function FindMatch(ByRef lookup As String, lookup_range As Range) As Long
    On Error Resume Next
    FindMatch = Application.Match(lookup, lookup_range, 0)
    On Error GoTo 0
End Function
 

Forum statistics

Threads
1,085,161
Messages
5,382,071
Members
401,768
Latest member
JAWHARRAH

Some videos you may like

This Week's Hot Topics

Top