Userform Remove in table if selection exists

chips

Board Regular
Joined
Oct 21, 2008
Messages
52
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




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
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Forum statistics

Threads
1,214,872
Messages
6,122,026
Members
449,061
Latest member
TheRealJoaquin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top