Question

Hi I have the following code that searches by the surname and returns values in the textbox. I want the checkboxes to checkmark depending on column 6 (f.offset(0,5)). But when i use the code below, it's not picking up the multiple values in a cell in column 6. it can only pick up the first one. how can i fix this?

Private Sub Search_Click()
Dim Name As String
Dim f As Range
Dim r As Long
Dim ws As Worksheet
Dim s As Integer
Dim FirstAddress As String
Dim str() As String

Name = surname.Value

With ws
 Set f = Range("A:A").Find(what:=Name, LookIn:=xlValues)
 If Not f Is Nothing Then
  With Me
    firstname.Value = f.Offset(0, 1).Value
    tod.Value = f.Offset(0, 2).Value
    program.Value = f.Offset(0, 3).Value
    email.Value = f.Offset(0, 4).Text
    officenumber.Value = f.Offset(0, 6).Text
    cellnumber.Value = f.Offset(0, 7).Text

str() = Split(f.Offset(0, 5), " ")

For i = 0 To UBound(str)

Select Case UCase(Trim(str(i)))
 Case "PACT": PACT.Value = True
 Case "PrinceRupert": PrinceRupert.Value = True
 Case "Montreal": Montreal.Value = True
 Case "TET": TET.Value = True
 Case "WPM": WPM.Value = True
 Case "TC": TC.Value = True
 Case "US": US.Value = True
 Case "Other": Other.Value = True

End Select

EDIT: I've used this code to add names to column 6

Private Sub CommandButton1_Click()
MsgBox "Directorate has been added", vbOKOnly

 Dim ctrl As Control
  For Each ctrl In UserForm1.Controls
    If TypeName(ctrl) = "CheckBox" Then
     'Pass this CheckBox to the subroutine below:
    TransferValues ctrl
    End If
  Next
 TransferMasterValue


Sub TransferMasterValue()
Dim allchecks As String
Dim ws As Worksheet
'Iterate through the checkboxes concatenating a string of all names
For Each ctrl In UserForm1.Controls
 If TypeName(ctrl) = "CheckBox" Then
    If ctrl Then
        allchecks = allchecks & ctrl.Name & " " 'the names of the checkboxes separated by a spcae in between them
        Debug.Print allchecks

    End If
 End If
Next

'If you have at least one transfer to the Master sheet
If Len(allchecks) > 0 Then
'Your code to transfer
 Set ws1 = Sheets("Master")
 emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

  With ws1
        .Cells(emptyRow, 1).Value = surname.Value
        .Cells(emptyRow, 2).Value = firstname.Value
        .Cells(emptyRow, 3).Value = tod.Value
        .Cells(emptyRow, 4).Value = program.Value
        .Cells(emptyRow, 5).Value = email.Value
        .Cells(emptyRow, 7).Value = officenumber.Value
        .Cells(emptyRow, 8).Value = cellnumber.Value
        .Cells(emptyRow, 6).Value = Left(allchecks, Len(allchecks) - 1) 'to add to column 6

EDIT 2:

This is how it's shown when i run debug.print allcheck above to add the names into column 6

PACT PrinceRupert 
PACT PrinceRupert Montreal 
PACT PrinceRupert Montreal WPM 
PACT PrinceRupert Montreal WPM TC 
PACT PrinceRupert Montreal WPM TC TET 
PACT PrinceRupert Montreal WPM TC TET US 
PACT PrinceRupert Montreal WPM TC TET US Other 

EDIT 3: https://www.dropbox.com/s/36e9fmbf17wpa0l/example.xlsm

Was it helpful?

Solution

You're running your select on upper-cased values, but the individual Case items are mixed-case. "PRINCERUPERT" won't match "PrinceRupert"

Either don't upper-case the Select item, or change all your Case terms to be upper-cased.

Edit - if it's still not working then you need to check what's being fed into your Select. Add the line shown below and see what it produces (will show up in the Immediate pane)

For i = 0 To UBound(str)
Debug.Print Trim(str(i))  '<< add this
Select Case UCase(Trim(str(i)))
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top