Warm tip: This article is reproduced from stackoverflow.com, please click
excel vba

VBA Best way to match an ID number from a spreadsheet to another sheet and then update the informati

发布于 2020-03-29 12:48:25

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?

Questioner
Adam Rhodes
Viewed
21
Adam Rhodes 2020-01-31 17:48

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.