Input a date into a VBA form in Excel

[PaulRob]

I am trying to have the user put in a DATE into a user form I have written into a VBA on the back of an Excel Spreadsheet.

Currently I have a txt box with the following coding:

Private Sub txtInServiceDate_Change()


End Sub

What/how do I change this so that the User inputs a date in the format mm/dd/yyyy please?

Thank you

 

[PaulRob]

So I have copied this in

Private Sub txtActualCost_AfterUpdate()
With Me.txtActualCost.value = Format(Val(.value), "$#,##0.00")
End With
End Sub

But when I run it the program it is constantly still failing over and adds in this sub

Private Sub Numformat_Change()

End Sub

And Compile says this line of Module is wrong

Me.txtActualCost.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 11)

??

 

[dmt32]

So I have copied this in

Private Sub txtActualCost_AfterUpdate()
With Me.txtActualCost.value = Format(Val(.value), "$#,##0.00")
End With
End Sub

That is not a copy of the code I posted in post #10
Please copy it exactly as published.

Private Sub txtActualCost_AfterUpdate()
    With Me.txtActualCost
        .Value = Format(Val(.Value), "$#,##0.00")
    End With
End Sub

As for other issues, this thread is about formatting entries in a userform textbox, if you have wider issues with your project then you would need to start a new thread.

Dave

 

[PaulRob]

So with this code:
Private Sub txtActualCost_AfterUpdate()
With Me.txtActualCost
.Value = Format(Val(.Value), "$#,##0.00")
End With
End Sub

using COPY and PASTE.
If I then compile the debug stops in the Module at this line
Me.txtActualCost.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 11)

and has additionally inserted this sub in the FORM immediately below the code you provided

Private Sub Numformat_Change()

End Sub

Additionally the line .Value = Format(Val(.Value), "$#,##0.00") is changed to .value = Format(Val(.value), "$#,##0.00") - dont know if that is important??

 

[dmt32]

Solution provided assumed that user would be entering data to the control in same way as the date - If this is not what you want then delete that code & try applying as follows

Me.txtActualCost.Value = Format(Val(Me.lstDatabase.List(Me.lstDatabase.ListIndex, 11)), "$#,##0.00")

The Val function is used to ensure a numeric value is returned otherwise it should display $0.00

If you are still having difficulty then suggest that to save keep guessing, that you publish all the code in your userform or better still, place copy of your workbook with dummy data on a file sharing site like dropbox & provide a link to it here.

Dave

 

[PaulRob]

UserForm code is:
Option Explicit
Public EnableEvents As Boolean

Private Sub cmbSearchColumn_Change()

If Me.EnableEvents = False Then Exit Sub

If Me.cmbSearchColumn.value = "All" Then

Call Reset
Else

Me.txtSearch.value = ""
Me.txtSearch.Enabled = True
Me.cmdSearch.Enabled = True

End If


End Sub

Private Sub cmdDelete_Click()

Dim iRow As Long

If Selected_List = 0 Then

MsgBox "No row is selected.", vbOKOnly + vbInformation, "Delete"
Exit Sub
End If

Dim i As VbMsgBoxResult

i = MsgBox("Do you want to delete the selected record?", vbYesNo + vbQuestion, "Confirmation")

If i = vbNo Then Exit Sub

iRow = Application.WorksheetFunction.Match(Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0), _
ThisWorkbook.Sheets("Database").Range("A:A"), 0)

ThisWorkbook.Sheets("Database").Rows(iRow).Delete

Call Reset

MsgBox "Selected record has been deleted.", vbOKOnly + vbInformation, "Deleted"



End Sub

Private Sub cmdEdit_Click()

If Selected_List = 0 Then

MsgBox "No row is selected.", vbOKOnly + vbInformation, "Edit"

Exit Sub

End If

'Code to update the value to respective controls

Dim sCategory As String

Me.txtRowNumber.value = Application.WorksheetFunction.Match(Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0), _
ThisWorkbook.Sheets("Database").Range("A:A"), 0)

Me.cmbCategory.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 1)

Me.txtEquipmentID.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)

Me.txtSerialNo.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)

Me.txtManufacturer.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)

Me.txtManufactureDate.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 5)

Me.txtVendor.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 6)

Me.txtModelNumber.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 7)

Me.txtInServiceDate.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 8)

Me.txtSize.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 9)

Me.txtType.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 10)

Me.txtActualCost.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 11)

Me.txtAssignedPersonnel.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 12)

Me.txtAssignedEquipment.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 13)

Me.cmbAssignedStation.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 14)

Me.txtRemovedfromServiceDate.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 15)


MsgBox "Please make the required changes and click on 'Save' button to update.", vbOKOnly + vbInformation, "Edit"



End Sub

Private Sub cmdFullScreen_Click()
Call Maximize_Restore
End Sub

Private Sub cmdPrint_Click()


Dim msgValue As VbMsgBoxResult

msgValue = MsgBox("Do you want to print the asset details?", vbYesNo + vbInformation, "Print")

If msgValue = vbNo Then Exit Sub

If ValidatePrintDetails() = True Then

Call Print_Form

End If


End Sub

Private Sub cmdReset_Click()
Dim msgValue As VbMsgBoxResult

msgValue = MsgBox("Do you want to reset the form?", vbYesNo + vbInformation, "Confirmation")

If msgValue = vbNo Then Exit Sub

Call Reset
End Sub

Private Sub cmdSave_Click()

Dim msgValue As VbMsgBoxResult

msgValue = MsgBox("Do you want to save the data?", vbYesNo + vbInformation, "Confirmation")

If msgValue = vbNo Then Exit Sub

If ValidateEntries() = True Then

Call Submit
Call Reset
End If

End Sub


Private Sub cmdSearch_Click()

If Me.txtSearch.value = "" Then

MsgBox "Please enter the search value.", vbOKOnly + vbInformation, "Search"
Exit Sub

End If

Call SearchData



End Sub

Private Sub txtActualCost_AfterUpdate()
With Me.txtActualCost
.value = Format(Val(.value), "$#,##0.00")
End With
End Sub

Private Sub txtInServiceDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Const DateFormat As String = "mm/dd/yyyy"

With Me.txtInServiceDate
Cancel = Len(.value) > 0 And Not IsDate(.value)
If Not Cancel Then .value = Format(.value, DateFormat) Else .value = ""
End With

If Cancel Then MsgBox "Please Enter A Valid In Service Date", 48, "Invalid"

End Sub

Private Sub txtManufactureDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Const DateFormat As String = "mm/dd/yyyy"

With Me.txtManufactureDate
Cancel = Len(.value) > 0 And Not IsDate(.value)
If Not Cancel Then .value = Format(.value, DateFormat) Else .value = ""
End With

If Cancel Then MsgBox "Please Enter A Valid Date of Manufacture if known", 48, "Invalid"

End Sub


Private Sub txtRemovedfromServiceDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Const DateFormat As String = "mm/dd/yyyy"

With Me.txtRemovedfromServiceDate
Cancel = Len(.value) > 0 And Not IsDate(.value)
If Not Cancel Then .value = Format(.value, DateFormat) Else .value = ""
End With

If Cancel Then MsgBox "Please Enter A Valid Date if Removed from Service", 48, "Invalid"

End Sub

Private Sub UserForm_Initialize()

Call Reset

End Sub

and Module is

Option Explicit
Public iWidth As Integer
Public iHeight As Integer
Public iLeft As Integer
Public iTop As Integer
Public bState As Boolean


Sub Reset()

Dim iRow As Long

iRow = [Counta(Database!A:A)] ' idetifying the last row

With frmForm

.cmbCategory = ""
.txtEquipmentID.value = ""
.txtSerialNo.value = ""

'Default Color

.cmbCategory.BackColor = vbWhite
.txtEquipmentID.BackColor = vbWhite
.txtSerialNo.BackColor = vbWhite
.txtManufacturer.BackColor = vbWhite
.txtManufactureDate.BackColor = vbWhite
'--------------------------------



.cmbCategory.Clear

'Creating a dynamic name for category

shSupport.Range("A2", shSupport.Range("A" & Application.Rows.Count).End(xlUp)).Name = "Dynamic"

.cmbCategory.RowSource = "Dynamic"

.txtEquipmentID.value = ""
.txtSerialNo.value = ""
.txtManufacturer.value = ""
.txtManufactureDate.value = ""
.txtVendor.value = ""
.txtModelNumber.value = ""
.txtInServiceDate.value = ""
.txtSize.value = ""
.txtType.value = ""
.txtActualCost.value = ""
.txtAssignedPersonnel.value = ""
.txtAssignedEquipment.value = ""

.cmbAssignedStation.Clear

'Creating a dynamic name for assigned station

shSupport.Range("O2", shSupport.Range("O" & Application.Rows.Count).End(xlUp)).Name = "Dynamic"

.cmbAssignedStation.RowSource = "Dynamic"

.txtRemovedfromServiceDate.value = ""

'Below code are associated with Search Feature - Part 3

Call Add_SearchColumn
ThisWorkbook.Sheets("Database").AutoFilterMode = False
ThisWorkbook.Sheets("SearchData").AutoFilterMode = False
ThisWorkbook.Sheets("SearchData").Cells.Clear

'-----------------------------------------------

.lstDatabase.ColumnCount = 18
.lstDatabase.ColumnHeads = True

.lstDatabase.ColumnWidths = "40,100,60,80,90,50,80,100, 50,50, 50, 50, 20, 20, 20, 50, 50, 50"

If iRow > 1 Then

.lstDatabase.RowSource = "Database!A2:R" & iRow
Else

.lstDatabase.RowSource = "Database!A2:R2"

End If



End With



End Sub


Sub Submit()

Dim sh As Worksheet
Dim iRow As Long

Set sh = ThisWorkbook.Sheets("Database")

If frmForm.txtRowNumber.value = "" Then

iRow = [Counta(Database!A:A)] + 1
Else

iRow = frmForm.txtRowNumber.value

End If


With sh

.Cells(iRow, 1) = "=Row()-1" 'Dynamic Serial Number

.Cells(iRow, 2) = frmForm.cmbCategory.value

.Cells(iRow, 3) = frmForm.txtEquipmentID

.Cells(iRow, 4) = frmForm.txtSerialNo

.Cells(iRow, 5) = frmForm.txtManufacturer

.Cells(iRow, 6) = frmForm.txtManufactureDate

.Cells(iRow, 7) = frmForm.txtVendor

.Cells(iRow, 8) = frmForm.txtModelNumber

.Cells(iRow, 9) = frmForm.txtInServiceDate

.Cells(iRow, 10) = frmForm.txtSize

.Cells(iRow, 11) = frmForm.txtType

.Cells(iRow, 12) = frmForm.txtActualCost

.Cells(iRow, 13) = frmForm.txtAssignedPersonnel

.Cells(iRow, 14) = frmForm.txtAssignedEquipment

.Cells(iRow, 15) = frmForm.cmbAssignedStation

.Cells(iRow, 16) = frmForm.txtRemovedfromServiceDate

.Cells(iRow, 17) = Application.UserName

.Cells(iRow, 18) = [Text(now(), "DD:MM:YYYY HH:MM")]

End With


End Sub


Sub Show_Form()

frmForm.Show

End Sub


Function Selected_List() As Long

Dim i As Long

Selected_List = 0

For i = 0 To frmForm.lstDatabase.ListCount - 1

If frmForm.lstDatabase.Selected(i) = True Then

Selected_List = i + 1
Exit For
End If

Next i


End Function


Sub Add_SearchColumn()

frmForm.EnableEvents = False

With frmForm.cmbSearchColumn

.Clear

.AddItem "All"

.AddItem "EquipmentID"
.AddItem "SerialNo"
.AddItem "Manufacturer"
.AddItem "ManufactureDate"
.AddItem "Vendor"
.AddItem "ModelNumber"
.AddItem "Size"
.AddItem "Type"
.AddItem "ActualCost"
.AddItem "AssignedPersonnel"
.AddItem "AssignedEquipment"
.AddItem "RemovedfromServiceDate"

.value = "All"


End With

frmForm.EnableEvents = True

frmForm.txtSearch.value = ""
frmForm.txtSearch.Enabled = False
frmForm.cmdSearch.Enabled = False

End Sub


Sub SearchData()

Application.ScreenUpdating = False

Dim shDatabase As Worksheet ' Database sheet
Dim shSearchData As Worksheet 'SearchData sheet

Dim iColumn As Integer 'To hold the selected column number in Database sheet
Dim iDatabaseRow As Long 'To store the last non-blank row number available in Database sheet
Dim iSearchRow As Long 'To hold the last non-blank row number available in SearachData sheet

Dim sColumn As String 'To store the column selection
Dim sValue As String 'To hold the search text value


Set shDatabase = ThisWorkbook.Sheets("Database")
Set shSearchData = ThisWorkbook.Sheets("SearchData")


iDatabaseRow = ThisWorkbook.Sheets("Database").Range("A" & Application.Rows.Count).End(xlUp).Row


sColumn = frmForm.cmbSearchColumn.value

sValue = frmForm.txtSearch.value


iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:R1"), 0)

'Remove filter from Database worksheet

If shDatabase.FilterMode = True Then

shDatabase.AutoFilterMode = False

End If

'Apply filter on Database worksheet

If frmForm.cmbSearchColumn.value = "Category" Then

shDatabase.Range("A1:R" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue

Else

shDatabase.Range("A1:R" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"

End If

If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("C:C")) >= 2 Then

'Code to remove the previous data from SearchData worksheet

shSearchData.Cells.Clear

shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1")

Application.CutCopyMode = False

iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(xlUp).Row

frmForm.lstDatabase.ColumnCount = 18

If iSearchRow > 1 Then

frmForm.lstDatabase.RowSource = "SearchData!A2:R" & iSearchRow

MsgBox "Records found."

End If


Else

MsgBox "No record found."

End If

shDatabase.AutoFilterMode = False
Application.ScreenUpdating = True


End Sub


Function ValidateEntries() As Boolean

ValidateEntries = True

Dim iEquipmentID As Variant

Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("Print")

iEquipmentID = frmForm.txtEquipmentID.value

With frmForm

'Default Color

.cmbCategory.BackColor = vbWhite
.txtEquipmentID.BackColor = vbWhite
.txtSerialNo.BackColor = vbWhite
.txtManufacturer.BackColor = vbWhite
.txtManufactureDate.BackColor = vbWhite
.txtVendor.BackColor = vbWhite
.txtModelNumber.BackColor = vbWhite
.txtInServiceDate.BackColor = vbWhite
.txtSize.BackColor = vbWhite
.txtType.BackColor = vbWhite
.txtActualCost.BackColor = vbWhite
.txtAssignedPersonnel.BackColor = vbWhite
.txtAssignedEquipment.BackColor = vbWhite
.cmbAssignedStation.BackColor = vbWhite
.txtRemovedfromServiceDate.BackColor = vbWhite
'--------------------------------

If Trim(.txtEquipmentID.value) = "" Then

MsgBox "Please enter Equipment ID.", vbOKOnly + vbInformation, "Equipment ID"
ValidateEntries = False
.txtEquipmentID.BackColor = vbRed
.txtEquipmentID.SetFocus
Exit Function

End If

'Validating Duplicate Entries
If Trim(.cmbCategory.value) = "" Then

MsgBox "Please select Category name from drop-down.", vbOKOnly + vbInformation, "Dpartment"
ValidateEntries = False
.cmbCategory.BackColor = vbRed
.cmbCategory.SetFocus
Exit Function

End If

If Not sh.Range("B:B").Find(what:=iEquipmentID, lookat:=xlWhole) Is Nothing Then

MsgBox "Duplicate Equipment ID found.", vbOKOnly + vbInformation, "Equipment ID"
ValidateEntries = False
.txtEquipmentID.BackColor = vbRed
.txtEquipmentID.SetFocus
Exit Function

End If

If Trim(.txtSerialNo.value) = "" Then

MsgBox "Please enter Serial Number", vbOKOnly + vbInformation, "Serial No"
ValidateEntries = False
.txtSerialNo.BackColor = vbRed
.txtSerialNo.SetFocus
Exit Function

End If

End With



End Function



Function ValidatePrintDetails() As Boolean

ValidatePrintDetails = True

Dim iEquipmentID As Variant

Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("Print")

iEquipmentID = frmForm.txtEquipmentID.value

With frmForm

'Default Color

.cmbCategory.BackColor = vbWhite
.txtEquipmentID.BackColor = vbWhite
.txtSerialNo.BackColor = vbWhite
.txtManufacturer.BackColor = vbWhite
.txtManufactureDate.BackColor = vbWhite
.txtVendor.BackColor = vbWhite
.txtModelNumber.BackColor = vbWhite
.txtInServiceDate.BackColor = vbWhite
.txtSize.BackColor = vbWhite
.txtType.BackColor = vbWhite
.txtActualCost.BackColor = vbWhite
.txtAssignedPersonnel.BackColor = vbWhite
.txtAssignedEquipment.BackColor = vbWhite
.cmbAssignedStation.BackColor = vbWhite
.txtRemovedfromServiceDate.BackColor = vbWhite
'--------------------------------

If Trim(.cmbCategory.value) = "" Then

MsgBox "Please select desired Category from drop-down.", vbOKOnly + vbInformation, "Category"
ValidatePrintDetails = False
.cmbCategory.BackColor = vbRed
.cmbCategory.SetFocus
Exit Function

End If

If Trim(.txtEquipmentID.value) = "" Then

MsgBox "Please enter Equipment ID.", vbOKOnly + vbInformation, "Equipment ID"
ValidatePrintDetails = False
.txtEquipmentID.BackColor = vbRed
.txtEquipmentID.SetFocus
Exit Function

End If

If Trim(.txtSerialNo.value) = "" Then

MsgBox "Please enter Serial No.", vbOKOnly + vbInformation, "Serial Number"
ValidatePrintDetails = False
.txtSerialNo.BackColor = vbRed
.txtSerialNo.SetFocus
Exit Function

End If

If Trim(.txtManufacturer.value) = "" Then

MsgBox "Please enter the Manufacturer's name.", vbOKOnly + vbInformation, "Manufacturer"
ValidatePrintDetails = False
.txtManufacturer.BackColor = vbRed
.txtManufacturer.SetFocus
Exit Function

End If

If Trim(.txtManufactureDate.value) = "" Then

MsgBox "Please enter the Date of Manufacture.", vbOKOnly + vbInformation, "Date ofManufacture"
ValidatePrintDetails = False
.txtManufactureDate.BackColor = vbRed
.txtManufactureDate.SetFocus
Exit Function

End If

If Trim(.txtVendor.value) = "" Then

MsgBox "Please enter the Vendor name.", vbOKOnly + vbInformation, "Vendor"
ValidatePrintDetails = False
.txtVendor.BackColor = vbRed
.txtVendor.SetFocus
Exit Function

End If

If Trim(.txtModelNumber.value) = "" Then

MsgBox "Please enter the Model Number.", vbOKOnly + vbInformation, "ModelNumber"
ValidatePrintDetails = False
.txtModelNumber.BackColor = vbRed
.txtModelNumber.SetFocus
Exit Function

End If

If Trim(.txtInServiceDate.value) = "" Then

MsgBox "Please enter the Model Number.", vbOKOnly + vbInformation, "In Service Date"
ValidatePrintDetails = False
.txtInServiceDate.BackColor = vbRed
.txtInServiceDate.SetFocus
Exit Function

End If

If Trim(.txtSize.value) = "" Then

MsgBox "Please enter the Size.", vbOKOnly + vbInformation, "Size"
ValidatePrintDetails = False
.txtSize.BackColor = vbRed
.txtSize.SetFocus
Exit Function

End If

If Trim(.txtType.value) = "" Then

MsgBox "Please enter the Type.", vbOKOnly + vbInformation, "Type"
ValidatePrintDetails = False
.txtType.BackColor = vbRed
.txtType.SetFocus
Exit Function

End If

If Trim(.txtActualCost.value) = "" Then

MsgBox "Please enter the Actual Cost.", vbOKOnly + vbInformation, "Actual Cost"
ValidatePrintDetails = False
.txtActualCost.BackColor = vbRed
.txtActualCost.SetFocus
Exit Function

End If

If Trim(.txtAssignedPersonnel.value) = "" Then

MsgBox "Please enter the Assigned Personnel.", vbOKOnly + vbInformation, "Assigned Personnel"
ValidatePrintDetails = False
.txtAssignedPersonnel.BackColor = vbRed
.txtAssignedPersonnel.SetFocus
Exit Function

End If

If Trim(.txtAssignedEquipment.value) = "" Then

MsgBox "Please enter the Assigned Equipment.", vbOKOnly + vbInformation, "Assigned Equipment"
ValidatePrintDetails = False
.txtAssignedEquipment.BackColor = vbRed
.txtAssignedEquipment.SetFocus
Exit Function

End If

If Trim(.cmbAssignedStation.value) = "" Then

MsgBox "Please select the Station from drop-down.", vbOKOnly + vbInformation, "AssignedStation"
ValidatePrintDetails = False
.cmbAssignedStation.BackColor = vbRed
.cmbAssignedStation.SetFocus
Exit Function

End If

If Trim(.txtRemovedfromServiceDate.value) = "" Then

MsgBox "Please enter the date removed from service.", vbOKOnly + vbInformation, "RemovedfromServiceDate"
ValidatePrintDetails = False
.txtRemovedfromServiceDate.BackColor = vbRed
.txtRemovedfromServiceDate.SetFocus
Exit Function

End If


End With



End Function


Sub Print_Form()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("Print")

With frmForm

sh.Range("E5").value = .cmbCategory.value

sh.Range("E7").value = .txtEquipmentID.value

sh.Range("E9").value = .txtSerialNo.value

sh.Range("E11").value = .txtManufacturer.value

sh.Range("E13").value = .txtManufactureDate.value

sh.Range("E15").value = .txtVendor.value

sh.Range("E17").value = .txtModelNumber.value

sh.Range("E19").value = .txtInServiceDate.value

sh.Range("E21").value = .txtSize.value

sh.Range("E23").value = .txtType.value

sh.Range("E25").value = .txtActualCost.value

sh.Range("E27").value = .txtAssignedPersonnel.value

sh.Range("E29").value = .txtAssignedEquipment.value

sh.Range("E31").value = .cmbAssignedStation.value

sh.Range("E33").value = .txtRemovedfromServiceDate.value

End With

'Code to Print the form or Export to PDF

sh.PageSetup.PrintArea = "$B$2:$I$34"

'sh.PrintOut copies:=1, IgnorePrintAreas:=False


sh.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & Application.PathSeparator & frmForm.txtEquipmentID.value & ".pdf"

MsgBox "Asset details have been printed.", vbOKOnly + vbInformation, "Print"

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub


Sub Maximize_Restore()

If Not bState = True Then

iWidth = frmForm.Width
iHeight = frmForm.Height
iTop = frmForm.Top
iLeft = frmForm.Left

'Code for full screen

With Application

.WindowState = xlMaximized
frmForm.Zoom = Int(.Width / frmForm.Width * 100)

frmForm.StartUpPosition = 0
frmForm.Left = .Left
frmForm.Top = .Top
frmForm.Width = .Width
frmForm.Height = .Height

End With

frmForm.cmdFullScreen.Caption = "Restore"
bState = True

Else

With Application

.WindowState = xlNormal
frmForm.Zoom = 100
frmForm.StartUpPosition = 0
frmForm.Left = iLeft
frmForm.Width = iWidth
frmForm.Height = iHeight
frmForm.Top = iTop

End With

frmForm.cmdFullScreen.Caption = "Full Screen"

bState = False


End If


End Sub

Is that helpful to you Dave?

 

[dmt32]

Is that helpful to you Dave?

First, suggest that you take time to understand How To Post Code on this site

Given time of year do not have much time to work my way through your code - it would be more helpful if can place copy of your workbook on a file sharing site like dropbox & provide a link to it here. Also, explain what it is you are doing when the error occurs.

Dave

 

[PaulRob]

Is this easier for you Dave? I thank you for your assistance. Must confess I have never used my google drive before either so hope this works!

Asset database.xlsm

drive.google.com

 

[dmt32]

Is this easier for you Dave? I thank you for your assistance.

I have the file but it is likely that I will not to get too much spare time over xmas to play with it.

Meantime, I did a quick compile & you have a missing control on your userform

Me.txtActualCost.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 11)

Add the control shown above & see if this goes someway to resolving your issue

Dave

 

[PaulRob]

Dave

Thank you for looking at the code, however that code is already in the cmdEdit section

Private Sub cmdEdit_Click()
   
    If Selected_List = 0 Then
   
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Edit"
       
        Exit Sub
   
    End If
   
    'Code to update the value to respective controls
   
    Dim sCategory As String
   
    Me.txtRowNumber.value = Application.WorksheetFunction.Match(Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0), _
    ThisWorkbook.Sheets("Database").Range("A:A"), 0)
   
    Me.cmbCategory.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 1)
   
    Me.txtEquipmentID.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)
       
    Me.txtSerialNo.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)
   
    Me.txtManufacturer.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)
   
    Me.txtManufactureDate.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 5)
   
    Me.txtVendor.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 6)
   
    Me.txtModelNumber.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 7)
   
    Me.txtInServiceDate.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 8)
   
    Me.txtSize.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 9)
   
    Me.txtType.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 10)
   
    Me.txtActualCost.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 11)
   
    Me.txtAssignedPersonnel.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 12)
   
    Me.txtAssignedEquipment.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 13)
   
    Me.cmbAssignedStation.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 14)
   
    Me.txtRemovedfromServiceDate.value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 15)
   
   
    MsgBox "Please make the required changes and click on 'Save' button to update.", vbOKOnly + vbInformation, "Edit"
   
   
   
End Sub

Or should I be looking somewhere else?

When I compile I get a "Method or Data Member not found" and it highlights the text of ".txtActualCost"

Thank you

 

[dmt32]

Dave

Thank you for looking at the code, however that code is already in the cmdEdit section

Or should I be looking somewhere else?

Yes the code exists but you do not have a control (Textbox) with that name in your userform
Try ADDING the control & name it accordingly

Dave