VBA for Generating Cycle Counts

[bneighbors9]

I am looking for a VBA assigned to a button that will generate a cycle count for inventory control purposes. Each time I press the button, a new list will populate and not repeat any part numbers from a previous time of pressing the button. The list of part numbers with description/ location are on sheet 1 , Column B through D. The count sheet that I need this information to go to is on sheet2.

The button needs to do the following
Put todays date in the top of the sheet2
Randomly pull 15 part numbers from sheet 1 and paste that onto the count sheet (Sheet2 in A4 through A18). It needs to not select any part number that has a date in the E column.
Once a part number has been selected, put todays date in column E on sheet 1 to show the date it was selected and to stop it from being selected again.
Be able to click the button over and over again to create a new list until all part numbers have been selected 1 time.

 

[bneighbors9]

I took out this line and it stopped doing that
Sheets("Sheet2").Range("A4").CurrentRegion.Clear

 

[kvsrinivasamurthy]

Try.

Sub SelectPartNumbers()
Dim T&, Lr&, cnt&, K&
Dim A, B, Dt
Lr = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
A = Sheets("Sheet1").Range("B2:D" & Lr)
Dt = Sheets("Sheet1").Range("E2:E" & Lr)
ReDim B(1 To UBound(A, 1), 1 To 1)
cnt = WorksheetFunction.Min(WorksheetFunction.CountIf(Sheets("Sheet1").Range("E2:E" & Lr), ""), 15)
If cnt > 0 Then

With CreateObject("Scripting.dictionary")
For T = 1 To cnt
Line1:
K = WorksheetFunction.RandBetween(1, UBound(A, 1))
If Not .exists(A(K, 1)) And Dt(K, 1) = "" Then
.Item(K) = Array(A(K, 1), A(K, 2), A(K, 3)): Dt(K, 1) = Date
Else
GoTo Line1
End If
Next T
Sheets("Sheet1").Range("E2:E" & Lr) = Dt
Sheets("Sheet1").Range("E2:E" & Lr).NumberFormat = "dd-mm-yyyy"
Sheets("Sheet2").Range("A4:C18").Clear
Sheets("Sheet2").Range("A4:C" & 4 + cnt - 1) = Application.Index(.items, 0, 0)
End With

End If
MsgBox cnt & " Part numbers are selected", vbOKOnly, "Free Part Numbers"
End Sub

 

[bneighbors9]

This is perfect. How can we put todays date in B2 when we click the button ?

 

[kvsrinivasamurthy]

Change this

Sheets("Sheet2").Range("A4:C" & 4 + cnt - 1) = Application.Index(.items, 0, 0)
End With

as

Sheets("Sheet2").Range("A4:C" & 4 + cnt - 1) = Application.Index(.items, 0, 0)
Sheets("Sheet2").Range("B2") = Date
End With

 

[bneighbors9]

This did not work, B2 is still empty when pressing the button

 

[kvsrinivasamurthy]

In image todays date is in B1. You are telling B2.
This line puts date in B2 of sheet2

Sheets("Sheet2").Range("B2") = Date

Have you added this line in code.

 

[bneighbors9]

That was my problem.. i changed it to B1 and it is working whole code is now working perfectly. You are the best, I cannot thank you enough

 

[kvsrinivasamurthy]

OK. Happy that your problem is solved.