Pulling cell values into text boxes in a userform upon selecting a certain combobox value

[nashle6]

Hi,

In general, the 'sheet' illustrated below possesses five columns: Name, Colour and Varied Scores;
...A ......B .....C ...D ...E
James .Blue ....5 ...6 ...8
Brian ..Blue ....3 ...9 ...7
Tim ....Green ..3 ...7 ...11
Sam ...Red .....5 ...5 ...5

In a userform I've created, I have two comboboxes and a single row of three textboxes; the first combobox pulls the Colour values and lists them, the second combobox pulls the Name values and lists them, and the single row of textboxes is intended for a Score to be inserted into each (3, in this example).

What I'm trying to achieve is make it so that when a Colour is selected in the first combobox, the second combobox is populated with a corresponding number of Names associated with that Colour (say for instance, when Blue is selected in the first combobox, the second combobox will list James and Brian) and then the Scores on the same row (so Blue - James - 5, 6, 8 [in three textboxes]) will populate the textboxes, and be modified within those textboxes, before saving the modifications via a Commandbutton. However, when a different name is selected in the second combobox, the textboxes empty and are populated with Scores associated with that name.

How could I go about achieving this?

Thank you in advance!

[HaHoBe]

Hi, nashle6,

In a userform I've created...

It would be a lot easier of you attach a sample workbook with that form.

Ciao,
Holger

[nashle6]

Hi Holger,

My apologies for not previously attaching a sample; I've attached one to this response.

[HaHoBe]

Hi, nashle6,

if you start working with VBA please take your time and have Google search for the Reddick Naming Conventions - IŽd never name a Textbox Frame, really never.

And I would take into consideration that any item should only appear once in a ComboBox. Last thing: I wouldnŽt place 2 Sets of Textboxes which are to be populated on the change of one ComboBox but to be altered on the change of a second - I would just use one set and fill that only after the name of a person has been selected and leave them empty otherwise.

HereŽs the code:

Private Sub ColourDrop_Change()
Dim lngCounter As Long
Dim lngCol As Long
Dim lngTB As Long
EntrantCB.Clear
For lngCounter = 1 To 2
  For lngCol = 1 To 3
    Controls("txtBox" & lngCounter & "_" & lngCol).Value = vbNullString
  Next lngCol
Next lngCounter
With Sheets("Scores")
  For lngCounter = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
    If UCase(.Cells(lngCounter, "B").Value) = UCase(ColourDrop.Value) Then
      lngTB = lngTB + 1
      EntrantCB.AddItem .Cells(lngCounter, "A").Value
      For lngCol = 1 To 3
        Controls("txtBox" & lngTB & "_" & lngCol).Value = .Cells(lngCounter, 2 + lngCol).Value
      Next lngCol
    End If
  Next lngCounter
End With
End Sub


Private Sub UserForm_Initialize()
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
Dim rngCell As Range

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Scores")

With wsSheet
  Set rnData = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp))
End With

With Me.ColourDrop
  .Clear
  For Each rngCell In rnData
    If WorksheetFunction.CountIf(wsSheet.Range("B2:B" & rngCell.Row), rngCell) = 1 Then
      .AddItem rngCell
    End If
  Next rngCell
  .ListIndex = -1
End With
End Sub

Ciao,
Holger

[nashle6]

Hi Holger,

Thank you for your contribution, the combobox's unique value-population segment of the code works swimmingly.
However, when I try to run the other part of the code, I receive the following error:
"Run-time error '-2147024809 (80070057)':
Could not find the specified object."
This occurs in this line:

Controls("txtBox" & lngCounter & "_" & lngCol).Value = vbNullString

Is there a way to amend it?

[HaHoBe]

Hi, nashle6,

the workbook posted from me runs without any error on my laptop with 7 Home Premium and Office2007 Professional. I will have to get another Computer with Office2010 to check if and how to maybe overcome the error.

IŽll be back later with an update on that.

Ciao,
Holger

[nashle6]

Thanks for that, Holger.

[HaHoBe]

Hi, nashle6,

I could only test it on a system with Windows 2003 Server and Office2010 HSE but encountered no errors there. My only guess right now would be to check inside the VBE (go Tools/Links) all Links for that workbook - not that I expect one to be broken because Excel will update older versions automaticly (but not the other way around).

Another possibility might be http://support.microsoft.com/kb/2598039.

If you these hints wonŽt help with the solution please upload the workbook causing the error - IŽll give that a try with Excel2003 and the conversion Kit to maybe find out what throws up the exception if nobody else comes up with a solution.

Ciao,
Holger

[nashle6]

Hi Holger,

I managed to get the worksheet you uploaded working (as it turned out, I was sampling the code you supplied earlier on in my sample worksheet); I've noticed though that when a colour is selected, the textbox's are populated with values pertaining to players associated with that particular colour (kind of making the player combobox somewhat redundant in that it doesn't need anything stored inside of it selected for the scores to be populated in the textbox's), as opposed to only being populated when a certain player is selected, with only the values associated with that player. So basically it's a drilldown of colour -> player of that colour -> textbox's populated with the scores associated with the selected player.

I've uploaded another workbook with a new form dubbed 'NewScoreModifier' with the additional row of textbox's removed, would the code work better with it?

Thanks again.

[HaHoBe]

Hi, nashle6,

you are the one to work with the form or distribute the workbook, I can just explain how I would like things to be set up (which doesnŽt mean that it should be solved in that way).

Code for NewScoreModifier without commands Clear and Modify:

Option Explicit

Private Sub ColourDrop_Change()

Dim lngCounter As Long
Dim lngCol As Long
Dim lngTB As Long

EntrantCB.Clear
For lngCol = 1 To 3
  Controls("txtBox" & lngCol).Value = vbNullString
Next lngCol

With Sheets("Scores")
  For lngCounter = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
    If UCase(.Cells(lngCounter, "B").Value) = UCase(ColourDrop.Value) Then
      lngTB = lngTB + 1
      EntrantCB.AddItem .Cells(lngCounter, "A").Value
    End If
  Next lngCounter
End With

End Sub

Private Sub EntrantCB_Change()

Dim lngCol As Long
Dim rngFound As Range

With Sheets("Scores")
  Set rngFound = .Range("A:A").Find(what:=EntrantCB.Value)
  If Not rngFound Is Nothing Then
    For lngCol = 1 To 3
      Controls("txtBox" & lngCol).Value = .Cells(rngFound.Row, 2 + lngCol).Value
    Next lngCol
  End If
  Set rngFound = Nothing
End With

End Sub

Private Sub UserForm_Initialize()

Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
Dim rngCell As Range

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Scores")

With wsSheet
  Set rnData = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp))
End With

With Me.ColourDrop
  .Clear
  For Each rngCell In rnData
    If WorksheetFunction.CountIf(wsSheet.Range("B2:B" & rngCell.Row), rngCell) = 1 Then
      .AddItem rngCell
    End If
  Next rngCell
  .ListIndex = -1
End With

End Sub

Ciao,
Holger

[nashle6]

Hi Holger,

Your solution works brilliantly.

Would you be able to explain a method of 'reversing' the function of "Private Sub EntrantCB_Change()" to populate cells using values in the textbox's without needing to create a private sub for each textbox, or a procedure which can produce the same, if not similar result?

Thank you once again.

[nashle6]

Hi Holger,

I've managed to get the code working (by correcting the Offset's dimensions).

As for the ID, would it be better if I include the code for it in a module, to be uploaded here as an attachment, or just post up the sub's code here (that is, if you need to take a look at it)? As for modifying EntrantCB to handle two columns and the sort, I could only modify the BoundColumn, ColumnCount and ColumnWidths properties, the ControlSource property can't seem to be set on the grounds of an invalid property value-input.

[HaHoBe]

Hi, nashle6,

change the code behind the userform to:

Dim blnNotNew As Boolean

'>>>CommandButton 'Modify'<<<
Private Sub ModifyCB_Click()

Dim rngFound As Range
Dim lngCol As Long

With Sheets("Scoring")
  Set rngFound = .Range("D:D").Find(what:=EntrantCB.List(EntrantCB.ListIndex, 1))
  If Not rngFound Is Nothing Then
    For lngCol = 3 To 8
      Cells(rngFound.Row, 2 + lngCol).Value = Controls("txtBox" & lngCol).Value
      Controls("txtBox" & lngCol).Value = vbNullString
    Next lngCol
    EntrantCB.Clear
    blnNotNew = True
    ColourDrop.ListIndex = -1
  End If
End With

End Sub

'>>>ComboBox 'ColourDrop'<<<
Private Sub ColourDrop_Change()

Dim lngCounter As Long
Dim lngCol As Long
Dim arr()
Dim lngArr As Long

EntrantCB.Clear
For lngCol = 3 To 8
  Controls("txtbox" & lngCol).Value = vbNullString
Next lngCol

With Sheets("Scoring")
  For lngCounter = 2 To .Cells(Rows.Count, "C").End(xlUp).Row
    If UCase(.Cells(lngCounter, "C").Value) = UCase(ColourDrop.Value) Then
      ReDim arr(lngArr, 1)
      arr(lngArr, 0) = .Cells(lngCounter, "A")
      arr(lngArr, 1) = .Cells(lngCounter, "D")
      lngArr = lngArr + 1
    End If
  Next lngCounter
End With
If blnNotNew Then
  Me.EntrantCB.Clear
Else
  With Me.EntrantCB
      .Clear
      .ColumnCount = 2
      .ColumnWidths = "50Pt;0Pt"
      .List = arr
      .ListIndex = 0
  End With
End If
blnNotNew = False

End Sub

'>>>ComboBox 'EntrantCB'<<<
Private Sub EntrantCB_Change()

Dim lngCol As Long
Dim rngFound As Range

With Sheets("Scoring")
  Set rngFound = .Range("A:A").Find(what:=EntrantCB.Value)
  If Not rngFound Is Nothing Then
    For lngCol = 3 To 8
      Controls("txtbox" & lngCol).Value = .Cells(rngFound.Row, 2 + lngCol).Value
    Next lngCol
  End If
  Set rngFound = Nothing
End With

End Sub

'>>> General <<<
Private Sub UserForm_Initialize()
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
Dim rngCell As Range

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Scoring")

With wsSheet
  Set rnData = .Range(.Range("C2"), .Range("C" & Rows.Count).End(xlUp))
End With

With Me.ColourDrop
  .Clear
  For Each rngCell In rnData
    If WorksheetFunction.CountIf(wsSheet.Range("C2:C" & rngCell.Row), rngCell) = 1 Then
      .AddItem rngCell
    End If
  Next rngCell
  .ListIndex = -1
End With
End Sub

Ciao,
Holger