I have created a form following a Youtube clip (Link Below). It is working but the search function is not working very well.
Fully Automated Data Entry Form
You can search for anything that has a text, but when you try and search for numbers it will come back with no records.
I believe there is coding missing to get this to work. I have input the VBA code below.
If anyone could help I would be very thankful, also please message me if you are happy to look at my excel sheet.
1.
2.
1. Is the one searching for the name = a text based search = Gets the Record
2. is the number search I preformed = a number based Search = No Records
Fully Automated Data Entry Form
You can search for anything that has a text, but when you try and search for numbers it will come back with no records.
I believe there is coding missing to get this to work. I have input the VBA code below.
If anyone could help I would be very thankful, also please message me if you are happy to look at my excel sheet.
1.
1. Is the one searching for the name = a text based search = Gets the Record
2. is the number search I preformed = a number based Search = No Records
VBA Code:
'---------------------------------------------------Module1---------------------------------------------------
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
.txtName.Value = ""
.txtNHS.Value = ""
'Creating a dynamic name for department
shSupport.Range("A2", shSupport.Range("A" & Application.Rows.Count).End(xlUp)).Name = "Dynamic"
.cmbCompany.RowSource = "Dynamic"
.cmbCompany.Value = ""
.txtRowNumber.Value = ""
'Creating a dynamic name for department
shSupport.Range("B2", shSupport.Range("B" & Application.Rows.Count).End(xlUp)).Name = "Dynamic"
.cmbCCG.RowSource = "Dynamic"
.cmbCCG.Value = ""
.txtRowNumber.Value = ""
.txtPostcode.Value = ""
.txtReqNo.Value = ""
.txtPONo.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 = 9
.lstDatabase.ColumnHeads = True
.lstDatabase.ColumnWidths = "30,60,75,40,60,45,55,70,70"
If iRow > 1 Then
.lstDatabase.RowSource = "Database!A2:I" & iRow
Else
.lstDatabase.RowSource = "Database!A2:I2"
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.txtName.Value
.Cells(iRow, 3) = frmForm.txtNHS.Value
.Cells(iRow, 4) = frmForm.cmbCompany.Value
.Cells(iRow, 5) = frmForm.cmbCCG.Value
.Cells(iRow, 6) = frmForm.txtPostcode.Value
.Cells(iRow, 7) = frmForm.txtReqNo.Value
.Cells(iRow, 8) = frmForm.txtPONo.Value
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 "Patient Name"
.AddItem "NHS Number"
.AddItem "Company"
.AddItem "CCG"
.AddItem "Postcode"
.AddItem "Req Number"
.AddItem "PO Number"
.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:I1"), 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 = "Patient Name" Then
shDatabase.Range("A1:I" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue
Else
shDatabase.Range("A1:I" & 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 = 9
frmForm.lstDatabase.ColumnWidths = "30, 60, 75, 40, 60, 45, 55, 70, 70"
If iSearchRow > 1 Then
frmForm.lstDatabase.RowSource = "SearchData!A2:I" & iSearchRow
MsgBox "Records found."
End If
Else
MsgBox "No record found."
End If
shDatabase.AutoFilterMode = False
Application.ScreenUpdating = 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
VBA Code:
'-------------------------------------------------Form (frmForm)-----------------------------------------------
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 sGender As String
Me.txtRowNumber.Value = Application.WorksheetFunction.Match(Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0), _
ThisWorkbook.Sheets("Database").Range("A:A"), 0)
Me.txtName.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 1)
Me.txtNHS.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)
Me.cmbCompany.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)
Me.cmbCCG.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)
Me.txtPostcode.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 5)
Me.txtReqNo.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 6)
Me.txtPONo.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 7)
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 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
Call Submit
Call Reset
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 UserForm_Initialize()
Call Reset
End Sub
