VBA VLookup Returning Serial Number into form text box and not the Date

alexdurc09

New Member
Joined
Sep 21, 2018
Messages
17
Hello,
I have a simple user form where end users choose the unique identifier and the form returns a list of other related fields using VBA Vlookup coding. The code works fine the all other fields apart from wherethere is a date; for the date it returns the equivalent serial number for thedate held in the range. How can I make sure that the date is returned into theuser form using the vlookup?

The code is below.

Reg 7 / 12 / 15 / 16 /17 are the date fields. I am new toVBA coding so apologise if this isnt the most efficient way of doing a vlookup.

Private Sub Reg1_AfterUpdate()
'Check to see if value exists
If WorksheetFunction.CountIf(Sheet1.Range("A:A"), Me.Reg1.Value) = 0 Then
MsgBox "This Container Number Doesn't Exist, Please Try Again..."
Me.Reg1.Value = ""
Exit Sub
End If
'Lookup values based on first control
With Me
.Reg2 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 2, 0)
.Reg3 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 3, 0)
.Reg4 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 4, 0)
.Reg5 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 5, 0)
.Reg6 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 6, 0)
.Reg7 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 7, 0)
.Reg8 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 8, 0)
.Reg9 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 9, 0)
.Reg10 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 10, 0)
.Reg11 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 11, 0)
.Reg12 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 12, 0)
.Reg13 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 13, 0)
.Reg14 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 14, 0)
.Reg15 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 15, 0)
.Reg16 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 16, 0)
.Reg17 = Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 17, 0)
End With
End Sub

Thanks,
Alex
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
You could use Format

Code:
.Reg7 = Format([COLOR=#333333]Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 7, 0)[/COLOR], "mm/dd/yyyy")
 
Upvote 0
That's brilliant, it works! Thank you :) Another question - what code would I use to colour code the boxes depending on how far away from an inspection date we are? i.e red for overdue / amber for its within three months / green over three months away?
 
Upvote 0
You could add this function anywhere outside your Sub/s

Code:
Private Function getColor(days)
    Select Case days
        Case Is < 0
            getColor = vbRed
        Case 0 To 90
            getColor = RGB(255, 191, 0)
        Case Else
            getColor = vbGreen
    End Select
End Function

Then your code would be

Code:
[COLOR=#333333].Reg7 = Format([/COLOR][COLOR=#333333][COLOR=#333333]Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 7, 0)[/COLOR][/COLOR][COLOR=#333333], "mm/dd/yyyy")
[/COLOR].Reg7.BackColor = getColor(DateDiff("d", Now(), .Reg7))
 
Last edited:
Upvote 0
I have had it working great, but now for some reason I am getting 'run time error 13: Type Mismatch. I have used the exact you have posted????
Thanks
 
Upvote 0

Forum statistics

Threads
1,223,883
Messages
6,175,167
Members
452,615
Latest member
bogeys2birdies

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