Sub Reset()
Dim iRow As Long
iRow = [Counta(Database!A:A)]
With FrmForm
.cmbFileNo.Value = Clear
shUnused.Range("E2", shUnused.Range("E" & Application.Rows.Count).End(xlUp)).Name = "UnusedNo"
.cmbFileNo.RowSource = "UnusedNo"
.cmbType.Value = Clear
.cmbType.AddItem "File"
.cmbType.AddItem "Picture"
.cmbType.AddItem "Website"
.cmbEvent.Value = Clear
.cmbEvent.AddItem "Birth"
.cmbEvent.AddItem "Burial"
.cmbEvent.AddItem "Christening"
.cmbEvent.AddItem "Death"
.cmbEvent.AddItem "Individual"
.cmbEvent.AddItem "Marriage"
.cmbEvent.AddItem "Residence"
.cmbExt.Value = Clear
.cmbExt.AddItem "pdf"
.cmbExt.AddItem "jpg"
.cmbFullName.Value = Clear
shNameWks.Range("A2", shNameWks.Range("A" & Application.Rows.Count).End(xlUp)).Name = "Dynamic"
.cmbFullName.RowSource = "Dynamic"
.txtDate.Value = ""
.txtDescription.Value = ""
Call Add_SearchColumn
ThisWorkbook.Sheets("Database").AutoFilterMode = False
ThisWorkbook.Sheets("SearchData").AutoFilterMode = False
ThisWorkbook.Sheets("SearchData").Cells.Clear
.lstDatabase.ColumnCount = 8
.lstDatabase.ColumnHeads = True
.lstDatabase.ColumnWidths = "55,40,40,50,20,150,40,150"
If iRow > 1 Then
.lstDatabase.RowSource = "Database!A2:H" & iRow
Else
.lstDatabase.RowSource = "Database!A2:H2"
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) = [Text(),"*"]
.Cells(iRow, 2) = FrmForm.cmbFileNo.Value
.Cells(iRow, 3) = FrmForm.cmbType.Value
.Cells(iRow, 4) = FrmForm.cmbEvent.Value
.Cells(iRow, 5) = FrmForm.cmbExt.Value
.Cells(iRow, 6) = FrmForm.cmbFullName.Value
.Cells(iRow, 7) = FrmForm.txtDate.Value
.Cells(iRow, 8) = FrmForm.txtDescription.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 H = 0 To FrmForm.lstDatabase.ListCount - 1
If FrmForm.lstDatabase.Selected(H) = True Then
Selected_List = H + 1
Exit For
End If
Next H
End Function
Sub Add_SearchColumn()
FrmForm.EnableEvents = False
With FrmForm.cmbSearchColumn
.Clear
.AddItem "All"
.AddItem "File Name"
.AddItem "File No."
.AddItem "File Type"
.AddItem "Event"
.AddItem "Full Name & YOB"
.AddItem "Hyperlink"
.AddItem "Est. Date of Event"
.AddItem "Despcription"
.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
Dim shSearchData As Worksheet
Dim iColumn As Integer
Dim iDatabaseRow As Long
Dim iSearchRow As Long
Dim sColumn As String
Dim sValue As String
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:H1"), 0)
If shDatabase.FilterMode = True Then
shDatabase.AutoFilterMode = False
End If
If shDatabase.FilterMode = True Then
shDatabase.AutoFilterMode = False
End If
If FrmForm.cmbSearchColumn.Value = "File No." Then
shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue
Else
shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"
End If
If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("C:C")) >= 2 Then
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 = 8
FrmForm.lstDatabase.ColumnWidths = "55, 40, 40, 50, 20, 150, 40, 150"
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 Reset()
Dim iRow As Long
iRow = [Counta(Database!A:A)]
With FrmForm
.cmbFileNo.Value = Clear
shUnused.Range("E2", shUnused.Range("E" & Application.Rows.Count).End(xlUp)).Name = "UnusedNo"
.cmbFileNo.RowSource = "UnusedNo"
.cmbType.Value = Clear
.cmbType.AddItem "File"
.cmbType.AddItem "Picture"
.cmbType.AddItem "Website"
.cmbEvent.Value = Clear
.cmbEvent.AddItem "Birth"
.cmbEvent.AddItem "Burial"
.cmbEvent.AddItem "Christening"
.cmbEvent.AddItem "Death"
.cmbEvent.AddItem "Individual"
.cmbEvent.AddItem "Marriage"
.cmbEvent.AddItem "Residence"
.cmbExt.Value = Clear
.cmbExt.AddItem "pdf"
.cmbExt.AddItem "jpg"
.cmbFullName.Value = Clear
shNameWks.Range("A2", shNameWks.Range("A" & Application.Rows.Count).End(xlUp)).Name = "Dynamic"
.cmbFullName.RowSource = "Dynamic"
.txtDate.Value = ""
.txtDescription.Value = ""
Call Add_SearchColumn
ThisWorkbook.Sheets("Database").AutoFilterMode = False
ThisWorkbook.Sheets("SearchData").AutoFilterMode = False
ThisWorkbook.Sheets("SearchData").Cells.Clear
.lstDatabase.ColumnCount = 8
.lstDatabase.ColumnHeads = True
.lstDatabase.ColumnWidths = "55,40,40,50,20,150,40,150"
If iRow > 1 Then
.lstDatabase.RowSource = "Database!A2:H" & iRow
Else
.lstDatabase.RowSource = "Database!A2:H2"
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) = [Text(),"*"]
.Cells(iRow, 2) = FrmForm.cmbFileNo.Value
.Cells(iRow, 3) = FrmForm.cmbType.Value
.Cells(iRow, 4) = FrmForm.cmbEvent.Value
.Cells(iRow, 5) = FrmForm.cmbExt.Value
.Cells(iRow, 6) = FrmForm.cmbFullName.Value
.Cells(iRow, 7) = FrmForm.txtDate.Value
.Cells(iRow, 8) = FrmForm.txtDescription.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 H = 0 To FrmForm.lstDatabase.ListCount - 1
If FrmForm.lstDatabase.Selected(H) = True Then
Selected_List = H + 1
Exit For
End If
Next H
End Function
Sub Add_SearchColumn()
FrmForm.EnableEvents = False
With FrmForm.cmbSearchColumn
.Clear
.AddItem "All"
.AddItem "File Name"
.AddItem "File No."
.AddItem "File Type"
.AddItem "Event"
.AddItem "Full Name & YOB"
.AddItem "Hyperlink"
.AddItem "Est. Date of Event"
.AddItem "Despcription"
.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
Dim shSearchData As Worksheet
Dim iColumn As Integer
Dim iDatabaseRow As Long
Dim iSearchRow As Long
Dim sColumn As String
Dim sValue As String
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:H1"), 0)
If shDatabase.FilterMode = True Then
shDatabase.AutoFilterMode = False
End If
If shDatabase.FilterMode = True Then
shDatabase.AutoFilterMode = False
End If
If FrmForm.cmbSearchColumn.Value = "File No." Then
shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue
Else
shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"
End If
If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("C:C")) >= 2 Then
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 = 8
FrmForm.lstDatabase.ColumnWidths = "55, 40, 40, 50, 20, 150, 40, 150"
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