I am doing an Excel Workbook project for a poker room. There is a Player Database within the program. Each player has an ID
number.
For the sake of my question I'm going to refer to two Sheets.
When a player comes in for that day they are logged in with Name
, ID
, and Time
(This sheet is Worksheets("Cashout")). Cashout Sheet
Then when the player buys poker chips they get added to another sheet (Worksheets("Tab")).Tab Sheet This sheet keeps track of the chips that are purchased. Some of these players get loans from the house so they end up with a Tab
. On the "Tab" sheet there is a cmd button called Cashout.
When the player is done for the day the goal is to click the cashout button and submit any remaining tab and the players end time to the "Cashout" sheet. Since both of these sheets have the players ID
number, I am thinking that is how I should find the record on the Cashout page, but let me know if there is an easier way.
I have it working with using do
loops and ActiveCell select, but it is a lot of code, and select
slows the process. I know there is a better way to do this possibly Find
, Match
or even a For Each
loop. Please let me know to change my code.
I am attaching the code that works, but I don't want to use it.
Private Sub CmdBtnCashout1_Click()
Dim LastRow As Long
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cnt As Integer
Set ws1 = Worksheets("Tab")
Set ws2 = Worksheets("Cashout")
Set Rng1 = Worksheets("Tab").Range("A5")
Set Rng2 = Worksheets("Tab").Range("C4")
Set Rng3 = Worksheets("Tab").Range("W5")
cnt = 1
Application.ScreenUpdating = False
Rng1.Select
Selection.Copy
ws2.Activate
ws2.Range("A4").Select
If ws2.Range("A4") = "" Then
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Activate
Rng2.Select
Application.CutCopyMode = False
Selection.Copy
ws2.Activate
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Activate
Rng3.Select
Application.CutCopyMode = False
Selection.Copy
ws2.Activate
ActiveCell.Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws2.Range("A1").Select
ws1.Activate
ws1.Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select
Else
Do Until ActiveCell.value = ""
ActiveCell.Offset(1, 0).Select
cnt = cnt + 1
If cnt > 49 Then Exit Do
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Activate
Rng2.Select
Application.CutCopyMode = False
Selection.Copy
ws2.Activate
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Activate
Rng3.Select
Application.CutCopyMode = False
Selection.Copy
ws2.Activate
ActiveCell.Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws2.Range("A1").Select
ws1.Activate
ws1.Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select
End If
Application.ScreenUpdating = True
End Sub
Tab sheet: with Cashout Button: the player name is in Cell A5, ID number is in A4, tab balance is in W5.
Cashout Sheet: player name is within the range of A4:A53 and Player ID number is in range of B4:B53 this is where i would need to match my reference then insert the tab balance from the Tab Sheet in range G4:G53 on the row with that player. I also want to just insert the time stamp in E4:E53.
The sub would be worksheet level sub on the Tab Sheet using the CashoutCommandBtn Click event
How should I do this?
I found a way to do this see the attached code which works perfectly except I have 20 subs for 20 buttons. I know there is a way for me to put the long code into a module and call it from a sub so I am going to try and work on that so that the 20 subs have at least minimal code instead of the long code.
\\ Private Sub CmdBtnCashout1_Click()
Dim Rng2 As Range
Dim TimeOut As Date
Dim wst As Worksheet
Dim wsco As Worksheet
Dim Rng1 As Range
Dim Balance As Range
Dim COPlayer As Range
Dim COPlayerRng As Range
Dim i As Integer
Dim j As Integer
Dim Urng1 As Range
Dim Urng2 As Range
Dim UnionRng As Range
Dim WinLoss As Range
Dim ChipReturn As Range
Set COPlayerRng = Worksheets("Cashout").Range("B4:B53")
Set wst = Worksheets("Tab")
Set wsco = Worksheets("Cashout")
i = 4
j = 5
Set Rng1 = Worksheets("Tab").Cells(i, 1)
Set Rng2 = Worksheets("Tab").Cells(1, 1)
Set Balance = Worksheets("Tab").Cells(j, 23)
Set WinLoss = Worksheets("Tab").Cells(j, 24)
Set COPlayer = COPlayerRng.Find(What:=Rng1.value,LookIn:=xlValues,LookAt:=xlWhole)
Set Urng1 = wst.Range(Cells(i, 1), Cells(j, 1))
Set Urng2 = wst.Range(Cells(i, 3), Cells(j, 22))
Set UnionRng = Union(Urng1, Urng2)
Set ChipReturn = wst.Range(Cells(i, 25), Cells(j, 25))
TimeOut = Time
Application.ScreenUpdating = False
Application.FindFormat.Clear
Application.ReplaceFormat.Clear
With COPlayer
.Offset(0, 7).value = Balance.value
.Offset(0, 3).value = TimeOut
.Offset(0, 6).value = WinLoss.value
End With
Rng2.Select
UnionRng.ClearContents
ChipReturn.ClearContents
wst.Range("A6:V43").Copy
wst.Range("A4").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
wst.Range("A1").Select
Application.FindFormat.Clear
Application.ReplaceFormat.Clear
Application.ScreenUpdating = True
End Sub \\
By using a few variables and the "find" function and "with" statement provided me with a solution that works. I am still new to VBA so if there is any way to streamline this code or to use a standard module and calling a sub from there to eliminate the code for 20 buttons let me know. The variables "i" and "j" are used to count rows in the Cells Property. The code above is for one of the buttons on the worksheet. when the command button is pressed the it looks for the matching value for the ID number. After that is complete it takes the data from cell "A4" and "A5 and "C4" and "V5" and moves that information to another worksheet. the variables "i" = 4 and "j" = 5. The next button code is identical except since the row changes "i" = 6 and "J" = 7 and so on.