excel - This VLookup code does not activate when i click on fill details button

Question

Please help here The VLookup does not work when I use the code in a userform but does in my module?? I have created a module so Would you create a module then call it to the userform code? If so how i tried to call a module to the userform the other day but nothing happened? Which would be the best way to go?

 Private Sub ListBox4_Change()

If Me.ListBox4 = "Fill Details" Then

Application.ScreenUpdating = False

Dim LstBox As Listbox
Dim SrcOpen As Workbook
Dim Des As Workbook
Dim JCM As Worksheet
Dim TGSR As Worksheet
Dim FilePath As String
Dim Filename As String
Dim DesDataRange As Range
Dim SrcDataRange As Range
Dim LastRow As Long


FilePath = "\TGS-SRV01ShareShopFloorPRODUCTIONJOB BOOK"
Filename = "JOB RECORD SHEET.xlsm"


Set Des = Workbooks("Automated Cardworker.xlsm")
Set JCM = Worksheets("Job Card Master")
Set SrcOpen = Workbooks.Open(FilePath & Filename)
Set TGSR = SrcOpen.Worksheets("TGS JOB RECORD")
Set LstBox = Me.ListBox4
LastRow = TGSR.Cells(TGSR.Rows.Count, "A").End(xlUp).row

Set SrcDataRange = TGSR.Range("A2" & LastRow)

Set DesDataRange = JCM.Range("A2:Q299")

 If LstBox.Selected(1) = True Then

 JCM.Range("A4").Value = Application.WorksheetFunction.VLookup(JCM.Range("G2"), SrcDataRange, 40, 0)
  Range("A4").Select

JCM.Range("C4").Value = Application.WorksheetFunction.VLookup(JCM.Range("G2"), SrcDataRange, 8, 0)
  Range("C4").Select

JCM.Range("D4").Value = Application.WorksheetFunction.VLookup(JCM.Range("G2"), SrcDataRange, 33, 0)
  Range("D4").Select

JCM.Range("F6").Value = Application.WorksheetFunction.VLookup(JCM.Range("G2"), SrcDataRange, 18, 0)
  Range("F6").Select
  
JCM.Range("A8").Value = Application.WorksheetFunction.VLookup(JCM.Range("G2"), SrcDataRange, 2, 0)
  Range("A8").Select
  
JCM.Range("C8").Value = Application.WorksheetFunction.VLookup(JCM.Range("G2"), SrcDataRange, 3, 0)
  Range("C8").Select
  
JCM.Range("G8").Value = Application.WorksheetFunction.VLookup(JCM.Range("G2"), SrcDataRange, 5, 0)
  Range("G8").Select
  
JCM.Range("K10").Value = Application.WorksheetFunction.VLookup(JCM.Range("G2"), SrcDataRange, 7, 0)
  Range("K10").Select
  
JCM.Range("K8").Value = Application.WorksheetFunction.VLookup(JCM.Range("G2"), SrcDataRange, 4, 0)
  Range("K8").Select

SrcOpen.Close
        
 Application.ScreenUpdating = True

End If
        
End Sub

question from:https://stackoverflow.com/questions/65830773/this-vlookup-code-does-not-activate-when-i-click-on-fill-details-button

Answer 1

Your code (once fixed) should run fine inside the userform: you don't need to move it to a module.

This will give you a single cell which is likely not where you expect.

Set SrcDataRange = TGSR.Range("A2" & LastRow)

I'd guess you meant something more like:

Set SrcDataRange = TGSR.Range("A2:A" & LastRow)

However if you're using VLOOKUP it expects a multi-column lookup table (with the matched column being the leftmost column). You can't use a single column and retrieve values from columns not included...

Some suggestions:

Private Sub ListBox4_Change()
    'use Constants for fixed values
    Const FilePath As String = "\TGS-SRV01ShareShopFloorPRODUCTIONJOB BOOK"
    Const Filename As String = "JOB RECORD SHEET.xlsm"
    
    Dim SrcOpen As Workbook
    Dim Des As Workbook
    Dim JCM As Worksheet
    Dim TGSR As Worksheet
    Dim DesDataRange As Range
    Dim SrcDataRange As Range
    
    If Me.ListBox4 = "Fill Details" Then
    
        Application.ScreenUpdating = False
        
        Set Des = ThisWorkbook 'Workbooks("Automated Cardworker.xlsm")
        Set JCM = Des.Worksheets("Job Card Master") 'needs workbook qualifier
        
        Set SrcOpen = Workbooks.Open(FilePath & Filename)
        Set TGSR = SrcOpen.Worksheets("TGS JOB RECORD")
        Set SrcDataRange = TGSR.Range("A2:A" & TGSR.Cells(Rows.Count, "A").End(xlUp).Row)
        Set DesDataRange = JCM.Range("A2:Q299")
        
        If Me.ListBox4.Selected(1) = True Then
            'use Match to locate the row
            m = Application.Match(JCM.Range("G2"), SrcDataRange, 0)
            If Not IsError(m) Then
                'got a match: copy values
                Set rw = SrcDataRange.Cells(m).EntireRow 'get the whole row
                JCM.Range("A4").Value = rw.Cells(40).Value
                JCM.Range("C4").Value = rw.Cells(8).Value
                JCM.Range("D4").Value = rw.Cells(33).Value
                JCM.Range("F6").Value = rw.Cells(18).Value
                JCM.Range("A8").Value = rw.Cells(2).Value
                JCM.Range("C8").Value = rw.Cells(3).Value
                'etc etc
            Else
                'no match...
                MsgBox "No match for '" & JCM.Range("G2") & "'"
            End If
        End If
        
        SrcOpen.Close False
        Application.ScreenUpdating = True
    End If
        
End Sub