VBA help

[bcs0262cop]

I have two sheets in a workbook. Sheet A contains approximately 50 names with about 100 unique numbers associated with each name. Sheet B has a cell with a dropdown which lists each name from sheet A. I would like a VBA code which when a name in sheet B is selected it will randomly select a number from sheet A which is associated with that name.

I currently use a function but with the function it changes every time something changes on the sheet

 

[Snakehips]

@bcs0262cop You have not shared your data ranges so the below is full of assumption.
Hopefully it is of some value?
Tested on limited data ranges.

AutoTraining.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	Name	#1	#2	#3	#4	#5	#6	#7	#8	#9	#10	#11	#12	#13	#14
2	Name _1	999	1000	1001	1002	1003	1004	1005	1006	1007	1008	1009	1010	1011	1012
3	Name _2	23	24	25	26	27	28	29	30	31	32	33	34	35	36
4	Name _3	88	89	90	91	92	93	94	95	96	97
5	Name _4	76	77	78	79	80	81	82
6
SheetA

AutoTraining.xlsm
	A	B	C
1	Name	Number
2	Name _2	25
3	Name _3	88
4	Name _2	29
5	Name _3	90
6	Name _2	34
7	Name _3	97
8	Name _4	82
9	Name _1	1002
10	Name _1	1011
11
12
SheetB

Cells with Data Validation
Cell	Allow	Criteria
A2:A12	List	=SheetA!$A$2:$A$20

Code for code pane of SheetB

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim NEntRng As Range
Dim NListRng As Range
Dim NumRng As Range
Dim NRow As Integer
Dim ROset As Integer
Dim RNum As Integer
Dim lr As Integer
Dim lrand As Integer

'Name list and number data sheet
Set wsA = Sheets("SheetA")       '<<<Edit sheet name to suit

'Valid range for name entry in THIS sheet, SheetB
Set NEntRng = Range("A2:A55")

'Check valid single cell entry
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, NEntRng) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub

'Otherwise
'last row of
lr = wsA.Range("A" & Rows.Count).End(xlUp).Row

'Range of name list
Set NListRng = wsA.Range("A2:A" & lr)  '<<< Edit range to suit

'Get row of entered name
 ' +1 below assumes row 1 of sheetA is header row and names start row 2  Edit to suit
NRow = WorksheetFunction.Match(Target, NListRng, 0) + 1
lrand = wsA.Cells(NRow, Columns.Count).End(xlToLeft).Column - 1

'Random number for picking  a column for number
NCol = WorksheetFunction.RandBetween(1, lrand) + 1
'get number for entered name
Application.EnableEvents = False
Target.Offset(0, 1) = wsA.Cells(NRow, NCol).Value
Application.EnableEvents = True
    
End Sub