Transfer Data from Userform to Worksheet Table

can you upload a sample workbook?

Mike, Thanks for replying & I have made an example sheet but for some reason the attach button isn't working..... So frustrating

Capture1.JPG

Capture2.JPG

Userform.xlsm

Are those all buttons next to the names? You can upload a work by clicking the Go Advanced and scrolling down to Manage Attachments and attaching your workbook

Okay I see it now, I will work on this while I watch these NFL Playoff games. So give me a little time

Take a look at the attached workbook. I did away with the Textbox's and Buttons and added a Listbox. Added code to the Team Combobox Change Event to load names to your Listbox. When the Names are loaded to the Listbox, I'm adding the Row number to Column 2 of the Listbox. This used to write back the data to the sheet.

To find the column for the week, I'm using the Right(ComboxTeam.Value,1) to get what week. And Looking for "W" & Right(ComboxTeam.Value,1) in row 1.

Duplicate post

Mike, was having prods opening but got it now....... I've had a play with it & it is defo better than the way I had it set up...... The fact once you select a player it is removed from the 1st listbox...... That will stop accidental duplicates.

Thank you very much.......

I'm going to add a button to open another userform to add a player & team to the sheet my code so far is below

P.s in my real worksheet I have Col b = last name, col C = First name & col D = full name via a formula, Col F is the team...... Is this the best way?

Private Sub CmdAddPlayer_Click()

Dim x As Range                 '   Declare a variable as a range object

For Each x In Range("B:B")     '  Search for our range object inside column A

If x.Value = "" Then           '   Check whether cell value is blank

x.Select                       '   Select the cell

ActiveCell = TbxLastName.Text

ActiveCell.Offset(0, 1).Select

ActiveCell = TbxFirstName.Text

ActiveCell.Offset(0, 2).Select

ActiveCell = CbxTeam.Text


Exit For                         '   Stop searching

End If                           '  End condition

Next x                           '  End loop

End Sub

Cleaned up your code some. No need to select cells. I guess I'm lost to why you have another userform? Are you using my updated workbook or are you still using yours?

Private Sub CmdAddPlayer_Click()
Dim cell As Range                   '   Declare a variable as a range object

 For Each cell In Range("B:B")      '  Search for our range object inside column A
    If cell.Value = "" Then         '  Check whether cell value is blank
        'cell.Select                '  Dont need to select cell.
        cell.Value = TbxLastName.Text
        cell.Offset(0, 1) = TbxFirstName.Text
        cell.Offset(0, 2) = CbxTeam.Text
       Exit For                     '  Stop searching
    End If                          '  End condition
 Next cell                          '  End loop

End Sub

You do something like this to check the range and a Message box to either clear the range and rewrite the cells or cancel.

Sub FindFirstLast()
    Dim vaValues As Variant
    Dim vaFilter As Variant
    Dim lFirst As Long
    Dim lLast As Long

    Const sFIND As String = "Team A"

    With Application.WorksheetFunction
        'Get a 1-d array from a column
        vaValues = .Transpose(Worksheets("Names").Range("C1:C80").Value)
        'Use match to get the first instance
        lFirst = .Match(sFIND, vaValues, False)
        'Filter on the values
        vaFilter = Filter(vaValues, sFIND)
        'Assumes they're all together
        lLast = lFirst + UBound(vaFilter)
        
        MsgBox "Range for " & sFIND & "Week 1 is: Range(D" & lFirst & ":D" & lLast & ")"
        ' Then we can use the CountA Function to check range for values
        MsgBox .CountA(Range("D" & lFirst & ":D" & lLast))
    End With
End Sub

Replace your btnAddPlayers with the code below.

Private Sub btnAddPlayers_Click()
 Dim iColumn As Long
 Dim iLooper As Long
 
 If lstSelectedPlayers.ListCount = 0 Then Exit Sub
 
 On Error Resume Next
 With Worksheets(shName)
    iColumn = .Cells(1).EntireRow.Find("W" & Right(Me.CbxWeek.Value, 1), , xlValues, xlWhole, xlByColumns, False).Column
 End With
 If Err.Number <> 0 Then Err.Clear: Exit Sub
 If CheckIfDataAlreadyEntered(iColumn, Me.CbxTeam.Value) > 0 Then
    MsgBox "Your message"
   Exit Sub
 End If
 ' Uses 2nd Column in the Listbox that stores the row that Player is on
 With lstSelectedPlayers
    For iLooper = 0 To .ListCount - 1
       Cells(.List(iLooper, 1), iColumn) = iLooper + 1
    Next
    .Clear
    Label2.Caption = "Count :" & .ListCount
 End With
End Sub

Add this code in Standard module where you have your SmileyFace1_Click

Function CheckIfDataAlreadyEntered(WhatColumn As Long, WhatTeam As String) As Long
    Dim vaValues As Variant
    Dim vaFilter As Variant
    Dim lFirst As Long
    Dim lLast As Long

    With Application.WorksheetFunction
        'Get a 1-d array from a column
        vaValues = .Transpose(Range(Cells(1, "C"), Cells(Rows.CountLarge, "C")).Value)
        'Use match to get the first instance
        lFirst = .Match(WhatTeam, vaValues, False)
        'Filter on the values
        vaFilter = Filter(vaValues, WhatTeam)
        'Assumes they're all together
        lLast = lFirst + UBound(vaFilter)
        
        CheckIfDataAlreadyEntered = .CountA(Range(Cells(lFirst, WhatColumn).Address, Cells(lLast, WhatColumn).Address))
    End With
End Function