# Create Sheet to index scores for a club

#### ShiftyThor

##### New Member
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:

 Division Stage Number Name Hit Factor Classic 1 Ira 2.57 Classic 2 Ira 0.97 Standard 1 Jason 5.36 Standard 1 Troy 5.29 Standard 1 Paul 5.18 Standard 1 Dion 2.80 Standard 2 Dion 5.36 Standard 2 Jason 3.67 Standard 2 Paul 3.39 Standard 2 Troy 1.61

<tbody>
</tbody>

I require the below output from the information above:

 Name Division Stage 1 Handicap Stage 2 Handicap Ira Classic 2.57 (To be inputted) 0.97 (To be inputted) Jason Standard 5.36 (To be inputted) 3.67 (To be inputted) Troy Standard 5.29 (To be inputted) 1.61 (To be inputted) Paul Standard 5.18 (To be inputted) 3.39 (To be inputted) Dion Standard 2.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.

#### theBardd

##### Rules violation
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
Worksheets("Output").Delete
On Error GoTo 0

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``````