Help with on cell change

mosslovell

New Member
Joined
Oct 5, 2014
Messages
4
Hi All,

Ive been trying to sort this out,

I found this code that works when I click in the column D
But what I also want is if I click in column E a Different list is loaded.

This is the code that works

Option Explicit
Dim fillRng As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LBColors As MSForms.ListBox
Dim LBobj As OLEObject
Dim i As Long
Set LBobj = Me.OLEObjects("ListJobs")
'------------------------------
' Set LBobj = Me.OLEObjects("ListOutcome") This is the list I want to load if column E is entered
'-------------------------------
Set LBColors = LBobj.Object
If Not Intersect(Target, [D:D]) Is Nothing Then
Set fillRng = Target
With LBobj
.Left = fillRng.Left
.Top = fillRng.Top
.Width = fillRng.Width
.Visible = True
End With
Else
LBobj.Visible = False
If Not fillRng Is Nothing Then
fillRng.ClearContents
With LBColors
If .ListCount <> 0 Then
For i = 0 To .ListCount - 1
If fillRng.Value = "" Then
If .Selected(i) Then fillRng.Value = .List(i)
Else
If .Selected(i) Then fillRng.Value = _
fillRng.Value & "," & .List(i)
End If
Next
End If
For i = 0 To .ListCount - 1
.Selected(i) = False
Next
End With
Set fillRng = Nothing
End If
End If

End Sub


Please Help

Moss
 

Some videos you may like

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

onlyadrafter

Well-known Member
Joined
Aug 19, 2003
Messages
5,703
Platform
  1. Windows
Hello,

haven't tested this, but running through it, it seems OK.

Code:
Option Explicit
Dim fillRng As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LBColors As MSForms.ListBox
Dim LBobj As OLEObject
Dim i As Long
    If Not Intersect(Target, [D:E]) Is Nothing Then
        If Not Intersect(Target, [D:D]) Is Nothing Then
            Set LBobj = Me.OLEObjects("ListJobs")
        End If
        If Not Intersect(Target, [E:E]) Is Nothing Then
            Set LBobj = Me.OLEObjects("ListOutcome")
        End If
        Set LBColors = LBobj.Object
        Set fillRng = Target
        With LBobj
            .Left = fillRng.Left
            .Top = fillRng.Top
            .Width = fillRng.Width
            .Visible = True
        End With
    Else
        LBobj.Visible = False
        If Not fillRng Is Nothing Then
            fillRng.ClearContents
            With LBColors
                If .ListCount <> 0 Then
                    For i = 0 To .ListCount - 1
                        If fillRng.Value = "" Then
                            If .Selected(i) Then fillRng.Value = .List(i)
                        Else
                        If .Selected(i) Then fillRng.Value = _
                            fillRng.Value & "," & .List(i)
                        End If
                    Next
                End If
                For i = 0 To .ListCount - 1
                    .Selected(i) = False
                 Next
            End With
            Set fillRng = Nothing
        End If
    End If
End Sub

Let me know if not working properly, may need a copy of the spreadsheet, if possible.
 

mosslovell

New Member
Joined
Oct 5, 2014
Messages
4
Thank you so much for your quick reply.

I have tried the cobe but get an error message saying Object variable or with block not set

How can I send you the spread sheet.

Moss
 

Watch MrExcel Video

Forum statistics

Threads
1,123,323
Messages
5,600,954
Members
414,417
Latest member
Nobu

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
Top