Hello I have a userform with the following listbox
FormANADate
FormANAShift
FormANANames
Form ANANames is multi select listbox
ANAES Data Entry is a worksheet in the current workbook that has many tables.
to find the right table to input data in the user form searches the date
all is working great until there is a duplicate name.
It just doesn't work at removing duplicate names if they are selected by the userform.
any help is greatly appreciated
FormANADate
FormANAShift
FormANANames
Form ANANames is multi select listbox
ANAES Data Entry is a worksheet in the current workbook that has many tables.
to find the right table to input data in the user form searches the date
all is working great until there is a duplicate name.
It just doesn't work at removing duplicate names if they are selected by the userform.
any help is greatly appreciated
VBA Code:
Private Sub btnANAOk_Click()
'checks if all boxes are ticked
If FormANADate.ListIndex = -1 Then
MsgBox "Select date"
Exit Sub
End If
If FormANANames.ListIndex = -1 Then
MsgBox "Select Name"
Exit Sub
End If
If FormANAShift.ListIndex = -1 Then
MsgBox "Select Shifts"
Exit Sub
End If
Dim sPrompt As String
sCode = Me.FormANAShift.Value 'get the bound column
sTime = Me.FormANAShift.Column(1, Me.FormANAShift.ListIndex)
sHrs = Me.FormANAShift.Column(2, Me.FormANAShift.ListIndex)
Set sh = Sheets("ANAES Data Entry") 'saves typing the whole sheet name in the future by assigning it to a variable
sh.Select
'formats the date so it matches the date on the worksheet
sDate = Format(CDate(FormANADate.Value), "ddd dd/mm")
'moves the shift selection to a range variable sCodeto be used later
sCode = FormANAShift.Value
'finds the date in the worksheet
Set f = sh.Rows(8).Find(sDate, , xlValues, xlPart, , , False)
'If the date exists go to the next row down where the values are held
If Not f Is Nothing Then
'sets the column number where the date is
col = f.Column
timeCol = col + 1
hrCol = col + 2
nameCol = col + 3
'finds the next empty cell in the column and assigns that row number to the variable lr
lr = sh.Columns(col).Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
Set searchnamesrange = sh.Range(Cells(10, nameCol), Cells(lr, nameCol))
'sets up a loop to search through all of the Names in the list box FormANANames to see what has been selected
For i = 0 To FormANANames.ListCount - 1 'finds out how many items are in Names which control how many times the if question is performed
If FormANANames.Selected(i) Then 'if the name is selected then
If Application.WorksheetFunction.CountIf(sh.Range(Cells(10, nameCol), Cells(lr, nameCol)), FormANANames.List(i, 0)) > 0 Then
matchrow = Application.WorksheetFunction.Match(FormANANames.List(i, 0), searchnamesrange) + 9
curShift = sh.Cells(matchrow, timeCol)
curShiftcode = sh.Cells(matchrow, col)
Select Case MsgBox(Buttons:=vbYesNoCancel + vbExclamation, Prompt:=FormANANames.List(i, 0) & " has already been added." & vbNewLine & _
"" & vbNewLine & _
"" & sDate & " " & curShiftcode & " " & curShift & vbNewLine & _
"" & vbNewLine & _
"Do you want to change their shift to " & vbNewLine & _
"" & vbNewLine & _
"" & sDate & " " & sCode & " " & sTime & _
"" & vbNewLine & _
"Click No if you want to leave things as they are")
Case vbYes
sh.Cells(10, nameCol).Select
Set tablename = ActiveCell.ListObject
sh.Cells(matchrow, col).Value = ""
sh.Cells(matchrow, timeCol).Value = ""
sh.Cells(matchrow, hrCol).Value = ""
sh.Cells(matchrow, nameCol).Value = ""
sh.Cells(matchrow, col - 1).Value = "=IF(R[-1]C[1]=RC[1],R[-1]C,R[-1]C+1)"
sh.Cells(matchrow, col).Value = sCode
sh.Cells(matchrow, timeCol).Value = sTime
sh.Cells(matchrow, hrCol).Value = sHrs
sh.Cells(matchrow, nameCol).Value = FormANANames.List(i, 0) '
Case vbNo
MsgBox Buttons:=vbInformation, Prompt:="Please select another Name"
Case vbCancel
End Select
Else
sh.Cells(10, nameCol).Select
Set tablename = ActiveCell.ListObject
Set newrow = tablename.ListRows.Add
With newrow
.Range(1) = "=IF(R[-1]C[1]=RC[1],R[-1]C,R[-1]C+1)"
.Range(2) = sCode
.Range(4) = sHrs
.Range(5) = FormANANames.List(i, 0)
End With
lr = lr + 1
End If
End If
Next
sh.Cells(10, nameCol).Select
Set tablename = ActiveCell.ListObject
Set columnstosortby = tablename.ListColumns(2).Range
With tablename.Sort
.SortFields.Clear
.SortFields.Add columnstosortby, Order:=xlAscending
.Header = xlYes
.Apply
End With
If FormANANames.Selected(FormANANames.ListIndex) = True Then
FormANANames.Selected(FormANANames.ListIndex) = False
End If
If FormANAShift.Selected(FormANAShift.ListIndex) = True Then
FormANAShift.Selected(FormANAShift.ListIndex) = False
End If
If FormANADate.Selected(FormANADate.ListIndex) = True Then
FormANADate.Selected(FormANADate.ListIndex) = False
End If
Else ' if there is no date that matches
MsgBox "Date " & sDate & " does not exist try again"
Call CheckInput
End If
End Sub