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:

Some videos you may like

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Watch MrExcel Video

Forum statistics

Threads
1,108,955
Messages
5,525,882
Members
409,669
Latest member
JDCupps

This Week's Hot Topics

Top