Generate a number using q button depending on a data validation list and increment it everytime it is pressed

I have 2 data validation list in which they are dependent in each other in generating a number First list is the User ID" in cell range "D3" and the list of users are in cells "B8:B15" ex. "User 1","User 2". . "User 7" and a blank. Second list is the "Account Number" in cell range "D4" and the list of account numbers are in cells "C8:C14" the list consist of "5010","5011","6010","6011","7010", "7011" and a blank. Both cells must have value first before it can generate a number by pressing a button. Each user has a unique list under them depending on the combination of "User ID" and "Account Number"

ex. User 1 & 5010 can generate only from 1-10 numbers, User 2 & 5010 from 11-20, User 3 & 5010 from 21-30. . User 7 & 5010 from 61-70 and User 1 & 5011 from 101-110, User 2 & 5011 from 111-120. . User 7 & 5011 from 161-170 etc. The generated ID will also increment +1 if clicked and will reset if it is clicked 10 times. This is my code below, I want to ask if there is a shorter way in doing it. I only finished 2 sets only in account number "5010" and "5011"

Private Sub CommandButton21_Click()

Dim S1, S2 As Worksheet
Dim ID As Integer

Set S1 = Sheets("Sheet1")
Set S2 = Sheets("Sheet2")

Set ID1_5010 = S1.Range("C18")
Set ID2_5010 = S1.Range("D18")
Set ID3_5010 = S1.Range("E18")
Set ID4_5010 = S1.Range("F18")
Set ID5_5010 = S1.Range("G18")
Set ID6_5010 = S1.Range("H18")
Set ID7_5010 = S1.Range("I18")

Set ID1_5011 = S1.Range("K18")
Set ID2_5011 = S1.Range("L18")
Set ID3_5011 = S1.Range("M18")
Set ID4_5011 = S1.Range("N18")
Set ID5_5011 = S1.Range("O18")
Set ID6_5011 = S1.Range("P18")
Set ID7_5011 = S1.Range("Q18")


If S1.Range("D3").Value = "User 1" And S1.Range("D4").Value = "5010" Then
    S1.Range("D5").Value = ID1_5010 + 1

ElseIf S1.Range("D3").Value = "User 2" And S1.Range("D4").Value = "5010" Then
    S1.Range("D5").Value = ID2_5010 + 1

ElseIf S1.Range("D3").Value = "User 3" And S1.Range("D4").Value = "5010" Then
    S1.Range("D5").Value = ID3_5010 + 1

ElseIf S1.Range("D3").Value = "User 4" And S1.Range("D4").Value = "5010" Then
    S1.Range("D5").Value = ID4_5010 + 1

ElseIf S1.Range("D3").Value = "User 5" And S1.Range("D4").Value = "5010" Then
    S1.Range("D5").Value = ID5_5010 + 1

ElseIf S1.Range("D3").Value = "User 6" And S1.Range("D4").Value = "5010" Then
    S1.Range("D5").Value = ID6_5010 + 1

ElseIf S1.Range("D3").Value = "User 7" And S1.Range("D4").Value = "5010" Then
    S1.Range("D5").Value = ID7_5010 + 1

ElseIf S1.Range("D3").Value = "User 1" And S1.Range("D4").Value = "5011" Then
    S1.Range("D5").Value = ID1_5011 + 1

ElseIf S1.Range("D3").Value = "User 2" And S1.Range("D4").Value = "5011" Then
    S1.Range("D5").Value = ID2_5011 + 1

ElseIf S1.Range("D3").Value = "User 3" And S1.Range("D4").Value = "5011" Then
    S1.Range("D5").Value = ID3_5011 + 1

ElseIf S1.Range("D3").Value = "User 4" And S1.Range("D4").Value = "5011" Then
    S1.Range("D5").Value = ID4_5011 + 1

ElseIf S1.Range("D3").Value = "User 5" And S1.Range("D4").Value = "5011" Then
    S1.Range("D5").Value = ID5_5011 + 1

ElseIf S1.Range("D3").Value = "User 6" And S1.Range("D4").Value = "5011" Then
    S1.Range("D5").Value = ID6_5011 + 1

ElseIf S1.Range("D3").Value = "User 7" And S1.Range("D4").Value = "5011" Then
    S1.Range("D5").Value = ID7_5011 + 1

Else
    MsgBox "User ID or IACO needs to be filled out before generating an ID!", vbCritical

End If
End Sub

Any help or recommendations/ suggestions is very helpful. Thank you!