Inserting image into user form advanced filtered selection LookupLists column "O".

Ralevam

New Member
Joined
Mar 23, 2019
Messages
9
I'm really new to VBA. Below is the code that downloaded with the excel file. What I'm looking to add to the user form is to be able to display an image of the corresponding part that has been filtered from column "D" into column "O" LookUpLists sheet from the Part ID combo box and display it in the Image1 frame.

I'd also like to clear the image if the reset form button is executed like the rest of the form does with the other fields.

When the form is initialized it clears columns "M" and "N" and not "O" column

I noticed when I edited the defined names PartSelList to include "O" column that once the form is executed it defaults to the original setting of column "M" and "N"



Code:
Code:
Option Explicit


Private Sub cboType_AfterUpdate()
On Error Resume Next
Dim ws As Worksheet
Dim cPart As Range
Set ws = Worksheets("LookupLists")


Me.cboPart.Value = ""
Me.cboPart.RowSource = ""


With ws
   .Range("CritPartCat").Cells(2, 1).Value _
      = Me.cboType.Value
   .Columns("A:D").AdvancedFilter _
      Action:=xlFilterCopy, _
      CriteriaRange:=.Range("CritPartCat"), _
      CopyToRange:=.Range("ExtPartDesc"), _
      Unique:=False
End With


'redefine the static named range
ThisWorkbook.Names.Add Name:="PartSelList", _
  RefersTo:="=" & ws.Name & "!" & _
  ws.Range("PartSelCatList").Address


Me.cboPart.RowSource = "PartSelCatList"


End Sub


Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("PartsData")


'revised code to avoid problems with
'Excel lists and tables in newer versions
   'find  first empty row in database
   ''lRow = ws.Cells(Rows.Count, 1) _
   ''  .End(xlUp).Offset(1, 0).Row
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
    
lPart = Me.cboPart.ListIndex


'check for a part number
If Trim(Me.cboPart.Value) = "" Then
  Me.cboPart.SetFocus
  MsgBox "Please enter a part number"
  Exit Sub
End If


'copy the data to the database
With ws
  .Cells(lRow, 1).Value = Me.cboPart.Value
  .Cells(lRow, 2).Value = Me.cboType.Value
  .Cells(lRow, 3).Value = Me.cboPart.List(lPart, 1)
  .Cells(lRow, 4).Value = Me.cboLocation.Value
  .Cells(lRow, 5).Value = Me.txtDate.Value
  .Cells(lRow, 6).Value = Me.txtQty.Value
End With


'clear the data
'ClearParts
Me.cboType.Value = ""
Me.cboPart.Value = ""
Me.cboPart.RowSource = ""


Me.cboLocation.Value = ""
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboType.SetFocus


End Sub


Private Sub cmdClose_Click()
  Unload Me
End Sub


Private Sub cmdReset_Click()
Dim iControl As control


For Each iControl In Me.Controls
If iControl.Name Like "cbo*" Then iControl = vbNullString
If iControl.Name Like "txtQty*" Then iControl = vbNullString


Next


End Sub


Private Sub UserForm_Initialize()
Dim cType As Range
Dim cPart As Range
Dim cLoc As Range
Dim ws As Worksheet
Set ws = Worksheets("LookupLists")


With ws
   .Range("CritPartCat").Cells(2, 1).ClearContents
   .Range("PartSelList").ClearContents
End With


For Each cType In ws.Range("PartCatList")
  With Me.cboType
    .AddItem cType.Value
  End With
Next cType


For Each cLoc In ws.Range("LocationList")
  With Me.cboLocation
    .AddItem cLoc.Value
  End With
Next cLoc


Me.cboPart.RowSource = ""


Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboType.SetFocus


End Sub

Thank You for any help!:)
 
Last edited by a moderator:

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,487
Messages
5,831,978
Members
430,099
Latest member
rdhoy

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