Change Event Actions (Change Back Color & Open Dropdown for the Next ComboBox) For UserForm

J

jaquai365

New Member
Joined
Apr 23, 2018
Messages
2
Hello,

First time poster and Self taught VBA Novice here in need of some assistance. I'm running into trouble getting my Userform to chnage the backcolor of controls based on dropdown selection and then select focus and open the dropdown menu of the next combobox. I shouldn't say it doesn't work, more like it's inconsistent.

Here is my full code below which starts with Dim currentrow as Long.

Thanks in advance for your help.

My VBA

Code: 
Dim currrentrow As Long




Private Sub cboCustReviews_Change()


If cboNewModelCarousel.Value = vbNullString Then
                
     cboNewModelCarousel.SetFocus
     SendKeys "%{down}"
    End If
                
    If cboNewModelCarousel.ListIndex > -1 Then
    cboNewModelCarousel.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With cboCustReviews
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
        
        End Select
        End With
End Sub


Private Sub cboLinkedCorrect_Change()
If cbovehiclepics.Value = vbNullString Then
                
    cbovehiclepics.SetFocus
     SendKeys "%{down}"
    End If
                
    If cbovehiclepics.ListIndex > -1 Then
    cbovehiclepics.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With cboLinkedCorrect
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
       
        End Select
        End With
End Sub


Private Sub cboOfferType_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 With cboOfferType
    Select Case .Value
        Case "Dealer Created Slide w/ Dealer Offer"
        .BackColor = &H80FF80


  Case "Dealer Created Slide w/ OEM Offer"


        .BackColor = &H80FF80


 Case "OEM Retail Slide w/ Dealer Offer"


        .BackColor = &H80FF80


Case "OEM Retail Offer"


        .BackColor = &H80FF80




        Case Else
        .BackColor = &HC0C0FF
       
        End Select
        End With
End Sub


Private Sub cboSpecialsRotator_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With cboSpecialsRotator
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
        
        End Select
        End With
End Sub


Private Sub ComboBox1_Change()
Dim i As Long, lastrow As Long, ws As Worksheet
Set ws = Sheets("Dealer 1")
lastrow = ws.Range("A" & Rows.Count).End(x1Up).Row
For i = 2 To lastrow
If (Me.ComboBox1.Value) = ws.Cells(i, "A") Then
MsgBox Me.ComboBox1.Value
Me.txtboxImageMapper = ws.Cells(i, "B").Value
Me.txtboxHeroMessage = ws.Cells(i, "c").Value
Me.cboOfferType = ws.Cells(i, "D").Value
Me.cboTaggedFirst = ws.Cells(i, "E").Value
Me.cboLinkedCorrect = ws.Cells(i, "F").Value
Me.cbovehiclepics = ws.Cells(i, "G").Value
Me.cboPriceIncentives = ws.Cells(i, "H").Value
Me.cboDiscounts = ws.Cells(i, "I").Value
Me.cboMatchBoxHero = ws.Cells(i, "J").Value
Me.cboCreateAssets = ws.Cells(i, "K").Value
Me.cboPrimarySecondary = ws.Cells(i, "L").Value
Me.cboIOM = ws.Cells(i, "M").Value
Me.cboPromoPricing = ws.Cells(i, "N").Value
Me.cboDealerEngaged = ws.Cells(i, "O").Value
Me.DtPickerWebChecks = ws.Cells(i, "P").Value
Me.cboInvSearchBar = ws.Cells(i, "Q").Value
Me.cboSpecialsRotator = ws.Cells(i, "R").Value
Me.cboCustReviews = ws.Cells(i, "S").Value
Me.cboNewModelCarousel = ws.Cells(i, "T").Value
Next i


End Sub


Private Sub CommandButton12_Click()
cboCreateAssets.Value = ""
cboPrimarySecondary.Value = ""
cboIOM.Value = ""
cboPromoPricing.Value = ""
cboDealerEngaged.Value = ""


End Sub












Private Sub cboDiscounts_Change()


If cboMatchBoxHero.Value = vbNullString Then
                
     cboMatchBoxHero.SetFocus
     SendKeys "%{down}"
    End If
                
    If cboMatchBoxHero.ListIndex > -1 Then
    cboMatchBoxHero.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With cboDiscounts
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
       
        End Select
        End With
End Sub


Private Sub cboInvSearchBar_Change()


   If cboSpecialsRotator.Value = vbNullString Then
                
     cboSpecialsRotator.SetFocus
     SendKeys "%{down}"
    End If
                
    If cboSpecialsRotator.ListIndex > -1 Then
    cboSpecialsRotator.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With cboInvSearchBar
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
       
        End Select
        End With
          
End Sub
Private Sub cboInvSearchBar_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 If cboInvSearchBar.Value = No Then
    cboInvSearchBar.BackColor = vbRed
    Exit Sub
    End If


End Sub
Private Sub cboMatchBoxHero_Change()
   
    With cboMatchBoxHero
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
        
        End Select
        End With
End Sub
Private Sub cboNewModelCarousel_Change()
                
    txtboxHeroMessage.SetFocus
    
    With cboNewModelCarousel
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
       
        End Select
        End With
End Sub
Private Sub cboOfferType_Change()
  If cboTaggedFirst.Value = vbNullString Then
                
   cboTaggedFirst.SetFocus
     SendKeys "%{down}"
    End If
                
    If cboTaggedFirst.ListIndex > -1 Then
   cboTaggedFirst.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With cboOfferType
    Select Case .Value
        


  Case "Dealer Created Slide w/ OEM Offer"


        .BackColor = &H80FF80


 Case "OEM Retail Slide w/ Dealer Offer"


        .BackColor = &H80FF80


Case "OEM Retail Offer"


        .BackColor = &H80FF80
        
Case "Dealer Created Slide w/ Dealer Offer"
        .BackColor = &H80FF80




        Case Else
        .BackColor = &HC0C0FF
       
        End Select
        End With


End Sub
Private Sub cboPriceIncentives_Change()


   If cboDiscounts.Value = vbNullString Then
                
     cboDiscounts.SetFocus
     SendKeys "%{down}"
    End If
                
    If cboDiscounts.ListIndex > -1 Then
    cboDiscounts.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With cboPriceIncentives
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
        
        End Select
        End With
End Sub
Private Sub cboSpecialsRotator_Change()
  
   If cboCustReviews.Value = vbNullString Then
                
     cboCustReviews.SetFocus
     SendKeys "%{down}"
    End If
                
    If cboCustReviews.ListIndex > -1 Then
    cboCustReviews.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With cboSpecialsRotator
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
        
        End Select
        End With
End Sub


Private Sub cboTaggedFirst_Change()
If cboLinkedCorrect.Value = vbNullString Then
                
     cboLinkedCorrect.SetFocus
     SendKeys "%{down}"
    End If
                
    If cboLinkedCorrect.ListIndex > -1 Then
   cboLinkedCorrect.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With cboTaggedFirst
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
       
        End Select
        End With


End Sub
Private Sub cbovehiclepics_Change()


If cboPriceIncentives.Value = vbNullString Then
                
    cboPriceIncentives.SetFocus
     SendKeys "%{down}"
    End If
                
    If cboPriceIncentives.ListIndex > -1 Then
    cboPriceIncentives.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With cbovehiclepics
    Select Case .Value
        Case "Yes"
        .BackColor = &HC0FFC0
        Case Else
        .BackColor = &HC0C0FF
       
        End Select
        End With
End Sub
Private Sub cmdEdit_Click()
answer = MsgBox("Are you sure you want to update this Dealerhips record?", vbYesNo + vbQuestion, "Update Dealership Record")
If answer = vbYes Then
Cells(currentrow, 1) = txtboxVehicleModel.Text
Cells(currentrow, 2) = txtboxImageMapper.Value
Cells(currentrow, 3) = txtboxHeroMessage.Text
Cells(currentrow, 4) = cboOfferType.Value
Cells(currentrow, 5) = cboTaggedFirst.Value
Cells(currentrow, 6) = cboLinkedCorrect.Value
Cells(currentrow, 7) = cbovehiclepics.Value
Cells(currentrow, 8) = cboPriceIncentives.Value
Cells(currentrow, 9) = cboDiscounts.Value
Cells(currentrow, 10) = cboMatchBoxHero.Value
Cells(currentrow, 11) = cboCreateAssets.Value
Cells(currentrow, 12) = cboPrimarySecondary.Value
Cells(currentrow, 13) = cboIOM.Value
Cells(currentrow, 14) = cboPromoPricing.Value
Cells(currentrow, 15) = cboDealerEngaged.Value
Cells(currentrow, 16) = dtpkrWebChecks.Value
Cells(currentrow, 17) = cboInvSearchBar.Value
Cells(currentrow, 18) = cboSpecialsRotator.Value
Cells(currentrow, 19) = cboCustReviews.Value
Cells(currentrow, 20) = cboNewModelCarousel.Value


End If


End Sub
Private Sub CommandButton2_Click()
 If currentrow = 2 Then
 MsgBox "You are on the first Vehicle in your list"
 Exit Sub
 End If
 
 currentrow = currentrow - 1
txtboxVehicleModel = Cells(currentrow, 1)
txtboxImageMapper = Cells(currentrow, 2)
txtboxHeroMessage = Cells(currentrow, 3)
cboOfferType = Cells(currentrow, 4)
cboTaggedFirst = Cells(currentrow, 5)
cboLinkedCorrect = Cells(currentrow, 6)
cbovehiclepics = Cells(currentrow, 7)
cboPriceIncentives = Cells(currentrow, 8)
cboDiscounts = Cells(currentrow, 9)
cboMatchBoxHero = Cells(currentrow, 10)
End Sub


Private Sub CommandButton3_Click()
 If currentrow = 19 Then
 MsgBox "You are on the last Vehicle in your list"
 Exit Sub
 End If
currentrow = currentrow + 1
txtboxVehicleModel = Cells(currentrow, 1)
txtboxImageMapper = Cells(currentrow, 2)
txtboxHeroMessage = Cells(currentrow, 3)
cboOfferType = Cells(currentrow, 4)
cboTaggedFirst = Cells(currentrow, 5)
cboLinkedCorrect = Cells(currentrow, 6)
cbovehiclepics = Cells(currentrow, 7)
cboPriceIncentives = Cells(currentrow, 8)
cboDiscounts = Cells(currentrow, 9)
cboMatchBoxHero = Cells(currentrow, 10)


End Sub
Private Sub CommandButton4_Click()
txtboxHeroMessage.Text = ""
txtboxHeroMessage.Text = ""
cboOfferType.Value = ""
cboTaggedFirst.Value = ""
cboLinkedCorrect.Value = ""
cbovehiclepics.Value = ""
cboPriceIncentives.Value = ""
cboDiscounts.Value = ""
cboMatchBoxHero.Value = ""


End Sub






Private Sub dtpkrWebChecks_Change()
cboInvSearchBar.DropDown
End Sub


Private Sub CommandButton8_Click()


End Sub


Private Sub MultiPage1_Change()


End Sub


Private Sub txtboxHeroMessage_Change()
 
   If cboOfferType.Value = vbNullString Then
                
     cboOfferType.SetFocus
     SendKeys "%{down}"
    End If
                
    If cboOfferType.ListIndex > -1 Then
    cboOfferType.SetFocus
    SendKeys "%{down}"
    Exit Sub
    End If
    
    With txtboxHeroMessage
    Select Case .Value
        Case ""
        .BackColor = &HC0C0FF
        Case Else
        .BackColor = &H80000005
        
        End Select
        End With
End Sub




Private Sub UserForm_Initialize()




currentrow = 2


txtboxVehicleModel = Cells(currentrow, 1)
txtboxImageMapper = Cells(currentrow, 2)
txtboxHeroMessage = Cells(currentrow, 3)
cboOfferType = Cells(currentrow, 4)
cboTaggedFirst = Cells(currentrow, 5)
cboLinkedCorrect = Cells(currentrow, 6)
cbovehiclepics = Cells(currentrow, 7)
cboPriceIncentives = Cells(currentrow, 8)
cboDiscounts = Cells(currentrow, 9)
cboMatchBoxHero = Cells(currentrow, 10)
cboCreateAssets = Cells(currentrow, 11)
cboPrimarySecondary = Cells(currentrow, 12)
cboIOM = Cells(currentrow, 13)
cboPromoPricing = Cells(currentrow, 14)
cboDealerEngaged = Cells(currentrow, 15)
DtPickerWebChecks = Cells(currentrow, 16)
cboInvSearchBar = Cells(currentrow, 17)
cboSpecialsRotator = Cells(currentrow, 18)
cboCustReviews = Cells(currentrow, 19)
cboNewModelCarousel = Cells(currentrow, 20)


End Sub
 
Last edited by a moderator:

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
You must log in or register to reply here.

Similar threads

M
  • Question Question
Need to add _AfterUpdate events to a dynamically-created class
Replies
1
Views
1K
Matrovsky
M
A
  • Question Question
Page break issues when exporting to pdf from userform (VBA)
Replies
0
Views
897
auglocqnuk
A
J
  • Question Question
Need help with Update, Next & Previous button for multi-page Userform
Replies
0
Views
1K
jaquai365
J
C
  • Question Question
Conditionally coloring textbox - Excel VBA
Replies
3
Views
653
Peter_SSs
Peter_SSs
J
  • Question Question
Double Click to change color
Replies
5
Views
796
Fluff
Fluff

Forum statistics

Threads
1,224,818
Messages
6,181,151
Members
453,021
Latest member
Justyna P

Share this page

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