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

[alexdurc09]

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

 

[sericom]

You could use Format

.Reg7 = Format([COLOR=#333333]Application.WorksheetFunction.VLookup(Me.Reg1, Sheet1.Range("Lookup"), 7, 0)[/COLOR], "mm/dd/yyyy")

 

[alexdurc09]

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?

 

[sericom]

You could add this function anywhere outside your Sub/s

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

[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))

 

[alexdurc09]

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

 

[alexdurc09]

Sorry, ignore my above comment - its now working, I had missed the . at the beginning.