Adding data to worksheet where unique identifier accumulates - excel

Question

I had a mate of mine create a VBA script for me for a rather large Excel file containing football player game records.
The file currently has around 7000 player names over 190000 odd rows and each player is granted a unique PID (PlayerID). So a player with 10 games played will have 10 rows with one unique PID.
The script goes off to a website, copies player data and pastes it to the end of my excel worksheet called (Goals). When this data is added to the worksheet if a player matched on surname and firstname already exists, the PID will be populated with that players PID. If, in the data being added from the website, the player does not already exist a new unique number is to be given to this player.
For example:
The Player Fred SMITH PID=1234 already exists, any new record for him will receive the PID of 1234.
A new player Joe BLOGGS is added via the script the PID for him shall be the highest existing PID + 1. So if Fred SMITH has the highest PID then Joe BLOGGS would then be assigned the PID of 1235.
The script works well until a new player is added.
Data before import:
PID | surname | firstname | Game |
1233| Jones | Mark | 1
1234| Smith | Fred | 2
Expected after import - Joe Blogs New player
PID | surname | firstname | Game |
1233| Jones | Mark | 1
1234| Smith | Fred | 2
1235| Bloggs | Joe | 3
1234| Smith | Fred | 3
Actual after import - Joe Blogs New player
PID | surname | firstname | Game |
1233| Jones | Mark | 1
1234| Smith | Fred | 2
1235| Bloggs | Joe | 3
1236| Smith | Fred | 3
I can see why this happens as the script says add 1 in column A, but how can I change it so it adds 1 to the highest number in column A rather than the number on the row above?
Here's the script:
For d = 1 To 300000
If Worksheets("Goals").Range("G" & CStr(d)).Value = surname Then
If Worksheets("Goals").Range("H" & CStr(d)).Value = firstname Then
PID = Worksheets("Goals").Range("A" & CStr(d)).Value
ID = Worksheets("Goals").Range("B" & CStr(d - 1)).Value + 1
Exit For
Else:
If Worksheets("Goals").Range("H" & CStr(d)).Value = "" Then
PID = Worksheets("Goals").Range("A" & CStr(d - 1)).Value + 1
ID = Worksheets("Goals").Range("B" & CStr(d - 1)).Value + 1
Exit For
End If
End If
Else:
If Worksheets("Goals").Range("A" & CStr(d)).Value = "" Then
PID = Worksheets("Goals").Range("A" & CStr(d - 1)).Value + 1
ID = Worksheets("Goals").Range("B" & CStr(d - 1)).Value + 1
Exit For
End If
End If
Next d

Answer 1

There's a bunch of other optimizations you would probably benefit from making to your script, leaving aside anything else - you're accessing the Object layer a LOT which will slow things down.
As for calculating the PID quickly, there's a number of good ways to do it. My personal favourite (because it minimizes worksheet layer access) would be to build a dictionary of existing PIDs before you do anything else. If you're only importing say, 20 records, that might take an appreciable amount of time, but otherwise, the ability to use .HasKey(PID) methods will save you a LOT of time. Dictionaries are great, especially in languages like VBA.
Side note: What you really want is a primary key in a database. For all that Access gets a lot of flac for being too easy to use wrong, it is probably a better tool for this kind of thing than Excel.
Anyway, I'll throw in an optimized script in a few minutes, but in the mean time, you might want to look at using something like
Excel.WorksheetFunction.Max(Worksheets("Goals").Range("A1:A30000"))
when you're after the highest number in a range...

Answer 2

While a helper column that combined the firstname and surname would speed up general lookup operations, creating a virtual one in a Scripting.Dictionary might be the best for your import operation.
To use a Scripting.Dictionary you will need to go into the VBE's Tools ► References and add Microsoft Scripting Runtime.
Your code sample looks like it is walking through 300K rows for each new imported player. You will be able to see where my understanding of your supplied snippet breaks down.
Dim d As Long, lID As Long, lPID As Long, sPLYR As String
Dim surname As String, firstname As String
Dim dPLYRs As New Scripting.Dictionary
dPLYRs.CompareMode = TextCompare
'populate scripting dictionary
With Worksheets("Goals")
lID = Application.Max(.Range("B:B"))
lPID = Application.Max(.Range("A:A"))
For d = 1 To .Cells(Rows.Count, "G").End(xlUp).Row
sPLYR = .Cells(d, "G").Value & Chr(124) & .Cells(d, "H").Value
If Len(sPLYR) > 1 And Not dPLYRs.Exists(sPLYR) Then
dPLYRs.Add Key:=sPLYR, Item:=.Cells(d, "A").Value
ElseIf Len(sPLYR) > 1 And dPLYRs.Exists(sPLYR) Then
'repair broken PIDs
.Cells(d, "A") = dPLYRs.Item(sPLYR)
End If
Next d
End With
'this is where your sample code loses me. I have no idea where surname and firstname come from
'you probably need a loop to cycle through the imported names
'you have a unique index of surname & Chr(124) & firstname as the dictionary keys for lookup with the PID as each key's item
sPLYR = surname & Chr(124) & firstname
dPLYRs.RemoveAll: Set dPLYRs = Nothing
So the dictionary gets populated with all existing players and repairs and PIDs it finds. I cannot determine from what you've offered up what to do past then.