Editing Records Through VBA Form

[skinfreak]

I have designed a nice VBA form that seems to work well but the powers that be have changed the spec. Initially the data entry was done all at once, but now they want to do this in stages.

My form features 4 tabs, and this corresponds more or less to the four stages of data entry (this was not intentional). What I need to do is give the user the ability to check if the record has been started and if so, append it.

Essentially I need a query to check for a customer number that is in Column A, and display data from this row to make the decision of either creating a new query or editing the current one (ie. data from certain other cells on that row).

It more or less needs to behave like Access with possibly forward and back arrows, but unfortunately Access is out of the question (£$£$!).

Am I on a loser with this? Are record search arrows possible in VBA, or should I scrap it and tell them to use Access? Anyone's ideas with this would be treated like a God for evermore...I don't want to bin what I've done but at the end of the day I'm not going to waste more time in case they change what they want again!

 

[sweater_vests_rock]

sf.

i wasn't sure what you want to do with this, so i just gave a simple, hard-coded example.

if you would like to accept a user-provided value, then you could use a simple input box:

    strID = InputBox("Enter ID: ", "Search IDs")
    If strID = "" Then Exit Sub

in place of strID = "123"

cheers. ben.

 

[skinfreak]

OK, making progress. I can tell it is working becuase if I no not enter the correct number, the not found message appears, however if I do, I get an error at "txtID.Value = c.Value". From this point I get 424 errors (Object Required).

Do I need to explicitly state the sheet that the data is coming from? Or are the data items the problem and have to be declared?

Private Sub FindID(MyID As String)
    
    Dim rngSearch As Range, c As Range
   
    Set rngSearch = Intersect(Columns("A:A"), ActiveSheet.UsedRange)
   
    Set c = rngSearch.Find(What:=MyID, LookIn:=xlValues, LookAt:=xlWhole)
   
    If c Is Nothing Then
        MsgBox "ID not found."
    Else
        c.EntireRow.Activate
            txtID.Value = c.Value
            txtSurName.Value = c.Offset(0, 1).Value
            txtForeName.Value = c.Offset(0, 2).Value
            txtNHS.Value = c.Offset(0, 3).Value
            txtSF.Value = c.Offset(0, 4).Value
            txtDOB.Value = c.Offset(0, 5).Value
            txtPostcode.Value = c.Offset(0, 6).Value

SNIP

            cboFHSeen.Value = c.Offset(0, 61).Value
            txtDateUSS.Value = c.Offset(0, 62).Value

    End If
       
'   Empty object variables
    Set rngSearch = Nothing
    Set c = Nothing
  
End Sub

 

[skinfreak]

Anyone?

 

[sweater_vests_rock]

hi john.

thanks for your pm.

i think the issue here is that Excel isn't sure what txtID is. since you're no longer in the userform module, the program isn't assuming txtID is on the userform. to get this to work, you'll need to identify the form name, then the object you wish to edit. for example

txtID.value = c.Value

becomes

Userform1.txtID.Value = c.Value

and so on.

hope this helps.
ben.

 

[skinfreak]

Certainly does help - no more errors! However, the values aren't populating the form. It looks as though the code is fine, but must be missing something. The boxes in the form are blank and I don't think I have deliberatly blanked everything because several form items (date boxes etc) are filled with defaults.

 

[skinfreak]

I don't know if I have put the Call Test in the wrong place as it was only working when I selected a button.

I have now placed it in the Userform_Initialize() at the very bottom (after all the options for combo boxes have been declared. Does it make a difference where I place this?

The call works, but if I select a correct ID, it comes up with ID not found.

 

[Norie]

skinfreak

Could you detail at what stage you are currently at?

Post what code you have, how the comboboxes are populated, what controls you have on the userform etc.

 

[sweater_vests_rock]

john.

as an example, create a new userform named Userform1 with three textboxes named txtID, txtForeName, and txtSurName. put this code in the userform module:

Private Sub UserForm_Initialize()
    
    Call Module1.FindID("test")

End Sub

create a new standard module named Module1. put this code in the new module:

Sub FindID(MyID As String)
    
    Dim rngSearch As Range, c As Range
    
    Set rngSearch = Intersect(Columns("A:A"), ActiveSheet.UsedRange)
    
    Set c = rngSearch.Find(What:=MyID, LookIn:=xlValues, LookAt:=xlWhole)
    
    If c Is Nothing Then
        MsgBox "ID not found."
    Else
        c.EntireRow.Activate
        With UserForm1
            .txtID.Value = c.Value
            .txtSurName.Value = c.Offset(0, 1).Value
            .txtForeName.Value = c.Offset(0, 2).Value
        End With
    End If
        
'   Empty object variables
    Set rngSearch = Nothing
    Set c = Nothing
  
End Sub

in the workbook containing this code, create a new worksheet and enter in
Cell A1: test
Cell B1: SurName
Cell C1: ForeName

goto the VBE and run your userform. your textbox will be populated with the values from A1, A2, and A3.

cheers. ben.

 

[skinfreak]

OK, here's what I have so far (and for context, this is for a hospital environment - I haven't a clue what half these items mean...)

frmMain - the Main Form

Private Sub btnBack1_Click()

Dim i As Long

i = MultiPage1.Pages.Count - 1

'If you are on the first Page select the last one
If MultiPage1.Value = 0 Then
    MultiPage1.Value = i
'If you are on the any other page - select the previous one
Else
    MultiPage1.Value = MultiPage1.Value - 1
End If

End Sub

Private Sub btnBack2_Click()

Dim i As Long

i = MultiPage1.Pages.Count - 1

'If you are on the first Page select the last one
If MultiPage1.Value = 0 Then
    MultiPage1.Value = i
'If you are on the any other page - select the previous one
Else
    MultiPage1.Value = MultiPage1.Value - 1
End If

End Sub

Private Sub btnBack3_Click()

Dim i As Long

i = MultiPage1.Pages.Count - 1

'If you are on the first Page select the last one
If MultiPage1.Value = 0 Then
    MultiPage1.Value = i
'If you are on the any other page - select the previous one
Else
    MultiPage1.Value = MultiPage1.Value - 1
End If

End Sub

Private Sub btnClose_Click()

    Dim c
    For Each c In CommandBars
    c.Enabled = True
    Next

    Unload Me
    'ThisWorkbook.Close savechanges:=True
    Application.Quit
    

End Sub

Private Sub btnNext1_Click()

Dim i As Long

i = MultiPage1.Pages.Count - 1

'If you are on the last Page select the first one
If MultiPage1.Value = i Then
    MultiPage1.Value = 0
'If you are on the any other page - select the next one
Else
    MultiPage1.Value = MultiPage1.Value + 1
End If



End Sub

Private Sub btnNext2_Click()

Dim i As Long

i = MultiPage1.Pages.Count - 1

'If you are on the last Page select the first one
If MultiPage1.Value = i Then
    MultiPage1.Value = 0
'If you are on the any other page - select the next one
Else
    MultiPage1.Value = MultiPage1.Value + 1
End If

End Sub
Private Sub btnNext3_Click()

Dim i As Long

i = MultiPage1.Pages.Count - 1

'If you are on the last Page select the first one
If MultiPage1.Value = i Then
    MultiPage1.Value = 0
'If you are on the any other page - select the next one
Else
    MultiPage1.Value = MultiPage1.Value + 1
End If

End Sub

Private Sub btnSave_Click()

ActiveWorkbook.Sheets("Data").Activate

    Range("A1").Select

    Do

    If IsEmpty(ActiveCell) = False Then

        ActiveCell.Offset(1, 0).Select
    End If

    Loop Until IsEmpty(ActiveCell) = True

    ActiveCell.Value = txtID.Value
    ' Continue offset list below

        ActiveCell.Offset(0, 1) = txtSurName.Value
        ActiveCell.Offset(0, 2) = txtForeName.Value
        ActiveCell.Offset(0, 3) = txtNHS.Value
        ActiveCell.Offset(0, 4) = txtSF.Value
        ActiveCell.Offset(0, 5) = txtDOB.Value
        ActiveCell.Offset(0, 6) = txtPostcode.Value
        ActiveCell.Offset(0, 7) = txtLHB.Value
        ActiveCell.Offset(0, 8) = txtDateRef.Value
        ActiveCell.Offset(0, 9) = cboTreatment.Value
        ActiveCell.Offset(0, 10) = cboIfFET.Value
        ActiveCell.Offset(0, 11) = txtBMI.Value
        ActiveCell.Offset(0, 12) = cboNoEmb.Value
        ActiveCell.Offset(0, 13) = txtNoEmb_Comm.Value
        ActiveCell.Offset(0, 14) = txtEmbFroz.Value
        ActiveCell.Offset(0, 15) = txtEmbryoDateStorage.Value
        ActiveCell.Offset(0, 16) = cboInfertility1.Value
        ActiveCell.Offset(0, 17) = txtInfertility1.Value
        ActiveCell.Offset(0, 18) = cboInfertility2.Value
        ActiveCell.Offset(0, 19) = txtInfertility2.Value
        ActiveCell.Offset(0, 20) = txtInfertDuration.Value
        ActiveCell.Offset(0, 21) = txtCycle.Value
        ActiveCell.Offset(0, 22) = txtGonad.Value
        ActiveCell.Offset(0, 23) = txtDoseStart.Value
        ActiveCell.Offset(0, 24) = cboRegime.Value
        ActiveCell.Offset(0, 25) = txtFollicles.Value
        ActiveCell.Offset(0, 26) = txtDateEggCollect.Value
        ActiveCell.Offset(0, 27) = txtDateCancel.Value
        ActiveCell.Offset(0, 28) = cboCancellation.Value
        ActiveCell.Offset(0, 29) = cboIfOHSS.Value
        ActiveCell.Offset(0, 30) = cboEmbReplace.Value
        ActiveCell.Offset(0, 31) = txtDateET.Value
        ActiveCell.Offset(0, 32) = txtEmbReplace_Comm.Value
        ActiveCell.Offset(0, 33) = cboPassageCath.Value
        ActiveCell.Offset(0, 34) = txtIUI_Comm.Value
        ActiveCell.Offset(0, 35) = cboSpermConcent.Value
        ActiveCell.Offset(0, 36) = txtDonorNumber.Value
        ActiveCell.Offset(0, 37) = cboFollicDrainPerform.Value
        ActiveCell.Offset(0, 38) = txtFollicDrain_Number.Value
        ActiveCell.Offset(0, 39) = cboOocytes.Value
        ActiveCell.Offset(0, 40) = txtOocytesNumb.Value
        ActiveCell.Offset(0, 41) = txtOocytesInject.Value
        ActiveCell.Offset(0, 42) = txtOocytesDamage.Value
        ActiveCell.Offset(0, 43) = txtOocytesNormFert.Value
        ActiveCell.Offset(0, 44) = txtOocytesAbnormFert.Value
        ActiveCell.Offset(0, 45) = txtOocytes_Comm.Value
        ActiveCell.Offset(0, 46) = txtFailedFert_Comm.Value
        ActiveCell.Offset(0, 47) = cboSourceSperm.Value
        ActiveCell.Offset(0, 48) = txtVolume.Value
        ActiveCell.Offset(0, 49) = cboEmbryo.Value
        ActiveCell.Offset(0, 50) = txtSplit_Comm.Value
        ActiveCell.Offset(0, 51) = txtEmbryoTrans.Value
        ActiveCell.Offset(0, 52) = txtEmbryoGrade.Value
        ActiveCell.Offset(0, 53) = txtCellNumber.Value
        ActiveCell.Offset(0, 54) = txtEmbryo_Comm.Value
        ActiveCell.Offset(0, 55) = txtEmbryoFroz.Value
        ActiveCell.Offset(0, 56) = txtStorageDate.Value
        ActiveCell.Offset(0, 57) = cboOutcome.Value
        ActiveCell.Offset(0, 58) = cboOutcomeType.Value
        ActiveCell.Offset(0, 59) = cboOutcomeFetalNumb.Value
        ActiveCell.Offset(0, 60) = txtOutcome_Comm.Value
        ActiveCell.Offset(0, 61) = cboFHSeen.Value
        ActiveCell.Offset(0, 62) = txtDateUSS.Value
    
' Select the first Cell of the Data Sheet
    Range("A1").Select
    
    Call Userform_Initialize
    
Dim frm As frmMain
    Dim vResponse As Variant
    
    'Instantiate frmMain
    'This has the same effect as: Load frmMain
    
    Set frm = New frmMain
    
    vResponse = MsgBox("Would you like to enter another pathway record?", vbYesNo)
    
    If vResponse = vbYes Then
        'Reload the form
'        Call Test
        frm.Show
    End If
    
    ' If not...
    
    Unload Me
    dbsplash.Show
        

End Sub
Private Sub cboCancellation_Click()
cboIfOHSS.Enabled = cboCancellation = "OHSS"
lblOHSS.Enabled = cboCancellation = "OHSS"
End Sub

Private Sub cboEmbRepIfDifficult_Click()
txtEmbReplace_Comm.Enabled = cboEmbRepIfDifficult = "No Embryo Replacement"
End Sub

Private Sub cboEmbReplace_Click()
cboEmbRepIfDifficult.Enabled = cboEmbReplace = "Difficult"
lblIfDiff.Enabled = cboEmbReplace = "Difficult"
txtDateET.Enabled = cboEmbReplace = "Easy"
End Sub

Private Sub cboEmbryo_Click()
txtSplit_Comm.Enabled = cboEmbryo = "ICSI/IVF Split"
End Sub

Private Sub cboInfertility1_Change()

End Sub

Private Sub cboNoEmb_Click()
txtNoEmb_Comm.Enabled = cboNoEmb = "No Fertilisation"
End Sub

Private Sub cboOutcome_Click()
'you can substitute the previous 5 lines by this oneliner
cboOutcomeType.Enabled = cboOutcome = "Positive"
lbl_OutcomePositive.Enabled = cboOutcome = "Positive"
End Sub



Private Sub cboTreatment_Click()
cboIfFET.Enabled = cboTreatment = "FET"
lblIfFET.Enabled = cboTreatment = "FET"
End Sub



Private Sub txtDateCancel_AfterUpdate()
Dim Ln1 As String, _
    Ln2 As String, _
    Ln3 As String, _
    Title As String

If Len(txtDateCancel.Text) <> 6 Then
    Ln1 = "You must enter 6 numeric characters to represent the desired date." & Chr(10)
    Ln2 = "(For example, to enter the date May 7, 2006 you simply enter 070506)" & Chr(10) & Chr(10)
    Ln3 = "Please try again."
    Title = "Invalid Date Entry"
    MsgBox (Ln1 & Ln2 & Ln3), , Title
    txtDateCancel.Text = ""
        
Else: txtDateCancel.Text = Format(txtDateCancel.Text, "##/##/##")
End If
End Sub

Private Sub txtDateEggCollect_AfterUpdate()
Dim Ln1 As String, _
    Ln2 As String, _
    Ln3 As String, _
    Title As String

If Len(txtDateEggCollect.Text) <> 6 Then
    Ln1 = "You must enter 6 numeric characters to represent the desired date." & Chr(10)
    Ln2 = "(For example, to enter the date May 7, 2006 you simply enter 070506)" & Chr(10) & Chr(10)
    Ln3 = "Please try again."
    Title = "Invalid Date Entry"
    MsgBox (Ln1 & Ln2 & Ln3), , Title
    txtDateEggCollect.Text = ""
        
Else: txtDateEggCollect.Text = Format(txtDateEggCollect.Text, "##/##/##")
End If
End Sub


Private Sub txtDateET_Change()
Dim Ln1 As String, _
    Ln2 As String, _
    Ln3 As String, _
    Title As String

If Len(txtDateET.Text) <> 6 Then
    Ln1 = "You must enter 6 numeric characters to represent the desired date." & Chr(10)
    Ln2 = "(For example, to enter the date May 7, 2006 you simply enter 070506)" & Chr(10) & Chr(10)
    Ln3 = "Please try again."
    Title = "Invalid Date Entry"
    MsgBox (Ln1 & Ln2 & Ln3), , Title
    txtDateET.Text = ""
        
Else: txtDateET.Text = Format(txtDateET.Text, "##/##/##")
End If
End Sub

Private Sub txtDateRef_AfterUpdate()
Dim Ln1 As String, _
    Ln2 As String, _
    Ln3 As String, _
    Title As String

If Len(txtDateRef.Text) <> 6 Then
    Ln1 = "You must enter 6 numeric characters to represent the desired date." & Chr(10)
    Ln2 = "(For example, to enter the date May 7, 2006 you simply enter 070506)" & Chr(10) & Chr(10)
    Ln3 = "Please try again."
    Title = "Invalid Date Entry"
    MsgBox (Ln1 & Ln2 & Ln3), , Title
    txtDateRef.Text = ""
        
Else: txtDateRef.Text = Format(txtDateRef.Text, "##/##/##")
End If
End Sub

Private Sub txtDateUSS_AfterUpdate()
Dim Ln1 As String, _
    Ln2 As String, _
    Ln3 As String, _
    Title As String

If Len(txtDateUSS.Text) <> 6 Then
    Ln1 = "You must enter 6 numeric characters to represent the desired date." & Chr(10)
    Ln2 = "(For example, to enter the date May 7, 2006 you simply enter 070506)" & Chr(10) & Chr(10)
    Ln3 = "Please try again."
    Title = "Invalid Date Entry"
    MsgBox (Ln1 & Ln2 & Ln3), , Title
    txtDateUSS.Text = ""
        
Else: txtDateUSS.Text = Format(txtDateUSS.Text, "##/##/##")
End If
End Sub

Private Sub txtDOB_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub

'Private Sub txtDOB_AfterUpdate()
   ' Me.txtDOB = DateFormat1(txtDOB)
'End Sub

Private Sub txtDOB_AfterUpdate()
Dim Ln1 As String, _
    Ln2 As String, _
    Ln3 As String, _
    Title As String

If Len(txtDOB.Text) <> 6 Then
    Ln1 = "You must enter 6 numeric characters to represent the desired date." & Chr(10)
    Ln2 = "(For example, to enter the date May 7, 2006 you simply enter 070506)" & Chr(10) & Chr(10)
    Ln3 = "Please try again."
    Title = "Invalid Date Entry"
    MsgBox (Ln1 & Ln2 & Ln3), , Title
    txtDOB.Text = ""
        
Else: txtDOB.Text = Format(txtDOB.Text, "##/##/##")
End If
End Sub

Private Sub txtEmbryoDateStorage_AfterUpdate()
Dim Ln1 As String, _
    Ln2 As String, _
    Ln3 As String, _
    Title As String

If Len(txtEmbryoDateStorage.Text) <> 6 Then
    Ln1 = "You must enter 6 numeric characters to represent the desired date." & Chr(10)
    Ln2 = "(For example, to enter the date May 7, 2006 you simply enter 070506)" & Chr(10) & Chr(10)
    Ln3 = "Please try again."
    Title = "Invalid Date Entry"
    MsgBox (Ln1 & Ln2 & Ln3), , Title
    txtEmbryoDateStorage.Text = ""
        
Else: txtEmbryoDateStorage.Text = Format(txtEmbryoDateStorage.Text, "##/##/##")
End If
End Sub


Private Sub txtStorageDate_AfterUpdate()
Dim Ln1 As String, _
    Ln2 As String, _
    Ln3 As String, _
    Title As String

If Len(txtStorageDate.Text) <> 6 Then
    Ln1 = "You must enter 6 numeric characters to represent the desired date." & Chr(10)
    Ln2 = "(For example, to enter the date May 7, 2006 you simply enter 070506)" & Chr(10) & Chr(10)
    Ln3 = "Please try again."
    Title = "Invalid Date Entry"
    MsgBox (Ln1 & Ln2 & Ln3), , Title
    txtStorageDate.Text = ""
        
Else: txtStorageDate.Text = Format(txtStorageDate.Text, "##/##/##")
End If
End Sub

Private Sub txtSurName_AfterUpdate()
    Me.txtSurName = ConvertToProper(txtSurName)
End Sub

Private Sub txtForeName_AfterUpdate()
    Me.txtForeName = ConvertToProper(txtForeName)
End Sub


Private Sub Userform_Initialize()

'Select the first Page
MultiPage1.Value = 0

cboOutcomeType.Enabled = False
lbl_OutcomePositive.Enabled = False
txtNoEmb_Comm.Enabled = False
cboIfFET.Enabled = False
lblIfFET.Enabled = False
cboEmbRepIfDifficult.Enabled = False
cboIfOHSS.Enabled = False
txtNoEmb_Comm.Enabled = False
lblIfDiff.Enabled = False
lblOHSS.Enabled = False
txtSplit_Comm.Enabled = False
txtEmbReplace_Comm.Enabled = False
txtDateET.Enabled = False
lblDateET.Enabled = False


'Source from Spreadsheet Columns
'Dim x As Worksheet, i As Integer
'Set x = Worksheets("DataOptions")
'i = 2
'With cboTreatment
'.Clear
'Do Until IsEmpty(x.Cells(i, 1))
'.AddItem (x.Cells(i, 1))
'i = i + 1
'Loop
'End With



txtID.SetFocus

With cboTreatment
    .AddItem "ICSI"
    .AddItem "IVF"
    .AddItem "DIVF"
    .AddItem "FET"
    End With
    cboTreatment.Value = ""

With cboIfFET
    .AddItem "ICSI embryos"
    .AddItem "IVF embryos"
    .AddItem "ICSI/IVF embryos"
    .AddItem "Oocyte Donation"
    .AddItem "Oocyte Recipient"
    .AddItem "IUI"
    .AddItem "DIUI"
    End With
    cboIfFET.Value = ""
    
    
With cboNoEmb
    .AddItem "Freeze All"
    .AddItem "No Fertilisation"
    End With
    cboNoEmb.Value = ""
    
With cboInfertility1
    .AddItem "Unexplained"
    .AddItem "Tubal factor"
    .AddItem "Male factor"
    .AddItem "Ovulatory disorder"
    .AddItem "Endometriosis"
    .AddItem "Other"
    End With
    cboInfertility1.Value = ""

With cboInfertility2
    .AddItem "Tubal factor"
    .AddItem "Male factor"
    .AddItem "Ovultory disorder"
    .AddItem "Endometriosis"
    .AddItem "Other"
    End With
    cboInfertility2.Value = ""
    
With cboRegime
    .AddItem "Step up"
    .AddItem "Step down"
    .AddItem "Stable"
    End With
    cboRegime.Value = ""

With cboCancellation
        .AddItem "Poor response"
        .AddItem "High FSH"
        .AddItem "OHSS"
End With
cboCancellation.Value = ""

With cboOutcome
        .AddItem "Positive"
        .AddItem "Negative"
    End With
    cboOutcome.Value = ""

With cboPassageCath
        .AddItem "Easy"
        .AddItem "Difficult"

End With
cboPassageCath.Value = ""

    
With cboOutcomeType
        .AddItem "Clinical"
        .AddItem "Biochemical"
        .AddItem "Missed Abortion"
        .AddItem "Ectopic"
    End With
    cboOutcomeType.Value = ""

With cboEmbReplace
        .AddItem "Easy"
        .AddItem "Difficult"
End With
cboEmbReplace.Value = ""

With cboEmbRepIfDifficult
        .AddItem "No Embryo Replacement"
        .AddItem "Freeze All"
        .AddItem "No fertilisation"
End With
cboEmbRepIfDifficult.Value = ""

With cboIfOHSS
    .AddItem "Mild"
    .AddItem "Moderate"
    .AddItem "Severe"
End With
cboIfOHSS.Value = ""

With cboSpermConcent
    .AddItem "Washed concentration"
    .AddItem "Washed good progression"
    .AddItem "Donor sperm used"
End With
cboSpermConcent.Value = ""

With cboFollicDrainPerform
    .AddItem "Yes"
    .AddItem "No"
End With
cboFollicDrainPerform.Value = ""

With cboOocytes
    .AddItem "Immature"
    .AddItem "Mature "
    .AddItem "Post mature"
End With
cboOocytes.Value = ""

With cboSourceSperm
    .AddItem "Ejaculate"
    .AddItem "Donor sperm"
    .AddItem "PESA"
    .AddItem "TESE"
    .AddItem "Stored"
    End With
cboSourceSperm.Value = ""


With cboEmbryo
    .AddItem "ICSI embryos"
    .AddItem "IVF embryos"
    .AddItem "ICSI/IVF Split"
    End With
cboEmbryo.Value = ""

With cboFHSeen
.AddItem "Yes"
.AddItem "No"
End With
cboFHSeen.Value = ""

With cboOutcomeFetalNumb
.AddItem "Singleton"
.AddItem "Twin"
.AddItem "High order multiple"
End With
cboOutcomeFetalNumb.Value = ""

' Call the Number Search
Call Test

End Sub

Splash Screen - Buttons for Data entry form, spreadsheet view or exit XL.

Private Sub Label2_Click()

End Sub

Private Sub CommandButton1_Click()

End Sub

Private Sub btnClose_Click()

    Dim c
    For Each c In CommandBars
    c.Enabled = True
    Next

    Unload Me
    'ThisWorkbook.Close savechanges:=True
    Application.Quit

End Sub

Private Sub btnEntry_Click()
    Unload dbsplash
    frmMain.Show vbModal
End Sub

Private Sub btnExport_Click()
    Dim c
    For Each c In CommandBars
    c.Enabled = True
    Next
    
    ActiveWindow.WindowState = xlMaximized
    ThisWorkbook.Activate
    Worksheets("Data").Activate
    Unload Me
End Sub

Private Sub Image2_Click()

End Sub

'Private Sub UserForm_Activate()
'    Application.OnTime Now + TimeValue("00:00:05"), "KillTheForm"
'End Sub

Private Sub Userform_Initialize()

    'Save and Close all previously open workbooks
    For Each w In Workbooks
        If w.Name <> ThisWorkbook.Name Then
            w.Close savechanges:=True
        End If
    Next w

    'Minimize Excel Window
    ActiveWindow.WindowState = xlMinimized
    'Minimize Excel Completely
    'Application.WindowState = xlMinimized
    
    Dim c
    For Each c In CommandBars
    c.Enabled = False
    Next
       
End Sub

Search Number Module:

'User Prompt
Sub Test()
    Dim strID As String
   
    'strID = "123"
    strID = InputBox("Enter ID: ", "Search IDs")
    If strID = "" Then Exit Sub
    Call FindID(strID)
End Sub
Private Sub FindID(MyID As String)
    
    Dim rngSearch As Range, c As Range
   
    Set rngSearch = Intersect(Columns("A:A"), ActiveSheet.UsedRange)
   
    Set c = rngSearch.Find(What:=MyID, LookIn:=xlValues, LookAt:=xlWhole)
   
    If c Is Nothing Then
        MsgBox "ID not found."
    Else
        c.EntireRow.Activate
            
            frmMain.txtID.Value = c.Value
            frmMain.txtSurName.Value = c.Offset(0, 1).Value
            frmMain.txtForeName.Value = c.Offset(0, 2).Value
            frmMain.txtNHS.Value = c.Offset(0, 3).Value
            frmMain.txtSF.Value = c.Offset(0, 4).Value
            frmMain.txtDOB.Value = c.Offset(0, 5).Value
            frmMain.txtPostcode.Value = c.Offset(0, 6).Value
            frmMain.txtLHB.Value = c.Offset(0, 7).Value
            frmMain.txtDateRef.Value = c.Offset(0, 8).Value
            frmMain.cboTreatment.Value = c.Offset(0, 9).Value
            frmMain.cboIfFET.Value = c.Offset(0, 10).Value
            frmMain.txtBMI.Value = c.Offset(0, 11).Value
            frmMain.cboNoEmb.Value = c.Offset(0, 12).Value
            frmMain.txtNoEmb_Comm.Value = c.Offset(0, 13).Value
            frmMain.txtEmbFroz.Value = c.Offset(0, 14).Value
            frmMain.txtEmbryoDateStorage.Value = c.Offset(0, 15).Value
            frmMain.cboInfertility1.Value = c.Offset(0, 16).Value
            frmMain.txtInfertility1.Value = c.Offset(0, 17).Value
            frmMain.cboInfertility2.Value = c.Offset(0, 18).Value
            frmMain.txtInfertility2.Value = c.Offset(0, 19).Value
            frmMain.txtInfertDuration.Value = c.Offset(0, 20).Value
            frmMain.txtCycle.Value = c.Offset(0, 21).Value
            frmMain.txtGonad.Value = c.Offset(0, 22).Value
            frmMain.txtDoseStart.Value = c.Offset(0, 23).Value
            frmMain.cboRegime.Value = c.Offset(0, 24).Value
            frmMain.txtFollicles.Value = c.Offset(0, 25).Value
            frmMain.txtDateEggCollect.Value = c.Offset(0, 26).Value
            frmMain.txtDateCancel.Value = c.Offset(0, 27).Value
            frmMain.cboCancellation.Value = c.Offset(0, 28).Value
            frmMain.cboIfOHSS.Value = c.Offset(0, 29).Value
            frmMain.cboEmbReplace.Value = c.Offset(0, 30).Value
            frmMain.txtDateET.Value = c.Offset(0, 31).Value
            frmMain.txtEmbReplace_Comm.Value = c.Offset(0, 32).Value
            frmMain.cboPassageCath.Value = c.Offset(0, 33).Value
            frmMain.txtIUI_Comm.Value = c.Offset(0, 34).Value
            frmMain.cboSpermConcent.Value = c.Offset(0, 35).Value
            frmMain.txtDonorNumber.Value = c.Offset(0, 36).Value
            frmMain.cboFollicDrainPerform.Value = c.Offset(0, 37).Value
            frmMain.txtFollicDrain_Number.Value = c.Offset(0, 38).Value
            frmMain.cboOocytes.Value = c.Offset(0, 39).Value
            frmMain.txtOocytesNumb.Value = c.Offset(0, 40).Value
            frmMain.txtOocytesInject.Value = c.Offset(0, 41).Value
            frmMain.txtOocytesDamage.Value = c.Offset(0, 42).Value
            frmMain.txtOocytesNormFert.Value = c.Offset(0, 43).Value
            frmMain.txtOocytesAbnormFert.Value = c.Offset(0, 44).Value
            frmMain.txtOocytes_Comm.Value = c.Offset(0, 45).Value
            frmMain.txtFailedFert_Comm.Value = c.Offset(0, 46).Value
            frmMain.cboSourceSperm.Value = c.Offset(0, 47).Value
            frmMain.txtVolume.Value = c.Offset(0, 48).Value
            frmMain.cboEmbryo.Value = c.Offset(0, 49).Value
            frmMain.txtSplit_Comm.Value = c.Offset(0, 50).Value
            frmMain.txtEmbryoTrans.Value = c.Offset(0, 51).Value
            frmMain.txtEmbryoGrade.Value = c.Offset(0, 52).Value
            frmMain.txtCellNumber.Value = c.Offset(0, 53).Value
            frmMain.txtEmbryo_Comm.Value = c.Offset(0, 54).Value
            frmMain.txtEmbryoFroz.Value = c.Offset(0, 55).Value
            frmMain.txtStorageDate.Value = c.Offset(0, 56).Value
            frmMain.cboOutcome.Value = c.Offset(0, 57).Value
            frmMain.cboOutcomeType.Value = c.Offset(0, 58).Value
            frmMain.cboOutcomeFetalNumb.Value = c.Offset(0, 59).Value
            frmMain.txtOutcome_Comm.Value = c.Offset(0, 60).Value
            frmMain.cboFHSeen.Value = c.Offset(0, 61).Value
            frmMain.txtDateUSS.Value = c.Offset(0, 62).Value

    End If
       
'   Empty object variables
    Set rngSearch = Nothing
    Set c = Nothing
  
End Sub

Load Form Module

Sub OpenClosureForm()
'
' OpenClosureForm Macro

frmMain.Show vbModal
End Sub

Sorry it's a lot!

 

[skinfreak]

goto the VBE and run your userform. your textbox will be populated with the values from A1, A2, and A3.

cheers. ben.

OK, this works! So therefore my code is doing something to undo or prevent this process.