Open user form upon enter key press

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,832
Office Version
  1. 2007
Platform
  1. Windows
Hi,
On my worksheet i have in column A customers names & in column P of that row is the receipt number for that customer.
What i would like to happen is when a certain customers name in cell A is selected when i press the enter key have it open my userform called Database & if possible to then take it one step further upon opening the userform have that customers records loaded.

I can assist further with info etc should you need any other input.

Thanks
 
Sort by date Sort by votes
Hi,
Just to be sure please advise.

Sheet code module.
Right click tab,view code paste.

Userform code module.
Alt +F11
Right click userform name
Then paste.

I ask because i keep getting a line break after Private m rw as long and SubData etc etc
 
Upvote 0

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
That's correct. And the line break is fine, it separates the private variables that are declared at module level from the macro.
 
Upvote 0
OK.
I save then close & reopen.
I see a message Only comments may appear after End Sub.
See my code
First line is in yellow.
I did paste the code below End Sub but the Option Explicit has moved up on its own.


Code: 
Private Sub Worksheet_Activate()Range("A6").Activate
End Sub
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Range("A6", Cells(Rows.Count, "A").End(xlUp)), Target) Is Nothing Then Exit Sub
    Cancel = True
    Database.LoadData Me, Target.Row
End Sub
 
Upvote 0
The statement Option Explicit should appear at the very top of the module before any code.
 
Upvote 0
Hi,
I have now done that but i get a knock on affect with other messages that now pop up.

The first error is Compile error variable not defined.
It relates to the following,for the time being i removed it so i can continue to see if the form opens "but needs to be correctly put in place etc"

Code: 
Private Sub UserForm_Initialize()
    Set ws = ThisWorkbook.Worksheets("Database")
   
    ComboBoxCustomersNames_Update
 
 
    ResetButtons False
    'start at first record
    Navigate Direction:=xlFirst
   
End Sub

With the above removed i save,close & open again.

I then get a compile error,Only comments may appear after End Sub.
It relates to this.

Code: 
Sub LoadData(ByVal ws As Worksheet, ByVal rw As Long)    Set m_ws = ws
    m_rw = rw
    Me.txtCustomer.Value = m_ws.Range("A" & m_rw).Value
    Me.txtRegistrationNumber.Value = m_ws.Range("B" & m_rw).Value
    Me.txtBlankUsed.Value = m_ws.Range("C" & m_rw).Value
    Me.txtVehicle.Value = m_ws.Range("D" & m_rw).Value
    Me.txtButtons.Value = m_ws.Range("E" & m_rw).Value
    Me.txtKeySupplied.Value = m_ws.Range("F" & m_rw).Value
    Me.txtTransponderChip.Value = m_ws.Range("G" & m_rw).Value
    Me.txtJobAction.Value = m_ws.Range("H" & m_rw).Value
    Me.txtProgrammerCloner.Value = m_ws.Range("I" & m_rw).Value
    Me.txtKeyCode.Value = m_ws.Range("J" & m_rw).Value
    Me.txtBiting.Value = m_ws.Range("K" & m_rw).Value
    Me.txtChassisNumber.Value = m_ws.Range("L" & m_rw).Value
    Me.txtVehicleYear.Value = m_ws.Range("N" & m_rw).Value
    Me.txtPaid.Value = m_ws.Range("O" & m_rw).Value
    With Me.TextBox1
        .SetFocus
        .SelStart = 0
        .SelLength = Len(.Value)
    End With
    Me.Show
End Sub


 Dim ws As Worksheet
 Dim r As Long
 Dim EventsEnable As Boolean
 Const startRow As Long = 6

Before i put the explicit code at the top this was at the top.

Code: 
 Dim ws As Worksheet Dim r As Long
 Dim EventsEnable As Boolean
 Const startRow As Long = 6
 
Upvote 0
Place Option Explicit at the very top of the module before anything else, then followed by your module level variables, and then followed by all macros.
 
Upvote 0
Option explicit is at the top on both of them

Here is the full code for both to show you.

Code: 
 Option Explicit

Private m_ws As Worksheet
Private m_rw As Long


Sub LoadData(ByVal ws As Worksheet, ByVal rw As Long)
    Set m_ws = ws
    m_rw = rw
    Me.txtCustomer.Value = m_ws.Range("A" & m_rw).Value
    Me.txtRegistrationNumber.Value = m_ws.Range("B" & m_rw).Value
    Me.txtBlankUsed.Value = m_ws.Range("C" & m_rw).Value
    Me.txtVehicle.Value = m_ws.Range("D" & m_rw).Value
    Me.txtButtons.Value = m_ws.Range("E" & m_rw).Value
    Me.txtKeySupplied.Value = m_ws.Range("F" & m_rw).Value
    Me.txtTransponderChip.Value = m_ws.Range("G" & m_rw).Value
    Me.txtJobAction.Value = m_ws.Range("H" & m_rw).Value
    Me.txtProgrammerCloner.Value = m_ws.Range("I" & m_rw).Value
    Me.txtKeyCode.Value = m_ws.Range("J" & m_rw).Value
    Me.txtBiting.Value = m_ws.Range("K" & m_rw).Value
    Me.txtChassisNumber.Value = m_ws.Range("L" & m_rw).Value
    Me.txtVehicleYear.Value = m_ws.Range("N" & m_rw).Value
    Me.txtPaid.Value = m_ws.Range("O" & m_rw).Value
    With Me.TextBox1
        .SetFocus
        .SelStart = 0
        .SelLength = Len(.Value)
    End With
    Me.Show
End Sub


 Dim ws As Worksheet
 Dim r As Long
 Dim EventsEnable As Boolean
 Const startRow As Long = 6


Private Sub ImageClose_Click()
    'close the form (itself)
    Unload Me
End Sub


Private Sub CloseUserForm_Click()
    'close the form (itself)
    Unload Me
End Sub


Private Sub ComboBoxCustomersNames_Change()
        If Not EventsEnable Then Exit Sub
'get record
    r = Me.ComboBoxCustomersNames.ListIndex + startRow - 1
    Navigate Direction:=0
End Sub


Private Sub ComboBoxCustomersNames_Update()
    With ComboBoxCustomersNames ' change as required
        .RowSource = ""
        .Clear
        .List = ws.Range("A6:A" & ws.Range("A" & Rows.Count).End(xlUp).Row).Value
    End With
End Sub


Private Sub DeleteRecord_Click()


Dim C As Range


With Sheets("DATABASE")
    Set C = .Range("A:A").Find(What:=txtCustomer.Value, _
                        After:=.Range("A5"), _
                        LookIn:=xlValues, _
                        lookat:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
End With


If Not C Is Nothing Then
    If MsgBox("Are you sure you want to delete the record for " & txtCustomer.Text & "?", vbYesNo + vbCritical) = vbYes Then
        Rows(C.Row).EntireRow.Delete
        MsgBox "The record for " & txtCustomer.Text & " has been deleted!"
    Else
        MsgBox "The record containing customer " & txtCustomer.Text & " was not deleted!"
    End If
Else
    MsgBox "There were no records containing customer " & txtCustomer.Text & " to be deleted"
End If


Set C = Nothing


Unload Me
End Sub


Private Sub NewRecord_Click()
    Dim i As Integer
    Dim IsNewCustomer As Boolean
    
    IsNewCustomer = CBool(Me.NewRecord.Tag)
    
        If Not IsNewCustomer Then
        If MsgBox("Are you sure you wish to cancel these new customer details?", 36, "Cancel New Customer Details") = vbNo Then Exit Sub
    End If
    
    Navigate Direction:=IIf(IsNewCustomer, xlNone, xlPrevious)


    'if new customer, add Date
    If IsNewCustomer Then
        Me.txtJobDate.Text = Format(Date, "dd/mm/yyyy")
        Me.txtCustomer.SetFocus
    End If
    
    ResetButtons IsNewCustomer


End Sub


Private Sub NextRecord_Click()
    Navigate Direction:=xlNext
End Sub


Private Sub OpenInvoice_Click()


    Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\"
    
    If txtInvoiceNumber = "N/A" Or Len(txtInvoiceNumber) = 0 Then
                MsgBox "Invoice N/A For This Customer", vbExclamation, "N/A INVOICE NOTICE"
    Else
        If Len(Dir(FILE_PATH & txtInvoiceNumber.Value & ".pdf")) = 0 Then
            If MsgBox("Would You Like To Open The Folder ?", vbCritical + vbYesNo, "Warning Invoice is Missing.") = vbYes Then
                CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\")
            End If
        Else
            CreateObject("Shell.Application").Open (FILE_PATH & txtInvoiceNumber.Value & ".pdf")
        End If
    End If
End Sub
Private Sub PrevRecord_Click()
    Navigate Direction:=xlPrevious
End Sub
Private Sub UpdateRecord_Click()


Dim C As Range
Dim i As Integer
Dim msg As String
If Not IsComplete(Form:=Me) Then Exit Sub
Dim IsNewCustomer As Boolean
'New Part
 Dim ctrl As MSForms.Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is MSForms.TextBox Then ctrl.BackColor = RGB(255, 255, 255)
    Next ctrl
'End New part


    If Me.NewRecord.Caption = "CANCEL" Then
        With Sheets("DATABASE")
            Set C = .Range("A:A").Find(What:=txtCustomer.Value, _
                                After:=.Range("A5"), _
                                LookIn:=xlValues, _
                                lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
        End With
        If Not C Is Nothing Then
              MsgBox "Customer already Exists, file did not update"
              Cells(C.Row, "Q").Value = TextBox1 '<<<<<<<<<<<<<<
              Exit Sub
        End If
    End If
    
    IsNewCustomer = CBool(Me.UpdateRecord.Tag)
       
    msg = "CHANGES SAVED SUCCESSFULLY"
        
    If IsNewCustomer Then
    'New record - check all fields entered
        r = startRow
        msg = "NEW CUSTOMER SAVED TO DATABASE"
        ws.Range("A6").EntireRow.Insert
        ResetButtons Not IsNewCustomer
        Me.NextRecord.Enabled = True
    End If
    
        On Error GoTo myerror
    Application.EnableEvents = False
    'Add / Update Record
    For i = 1 To UBound(ControlNames)
                        With Me.Controls(ControlNames(i))
            'check if date value
            If IsDate(.Text) Then
                ws.Cells(r, i).Value = DateValue(.Text)
            ElseIf i = 15 Then
            If .Text = "" Then
                     MsgBox .Name & " is empty!"
                     Exit Sub
                End If
                ws.Cells(r, i).Value = Val(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11
                ws.Cells(r, "P").Font.Size = 16
        End With


    Next i
    
    If IsNewCustomer Then
        Call ComboBoxCustomersNames_Update
        Range("A6:Q6").Interior.ColorIndex = 6
        
        With Sheets("DATABASE")
            If .AutoFilterMode Then .AutoFilterMode = False
            x = .Cells(.Rows.Count, 1).End(xlUp).Row
                .Range("A5:Q" & x).Sort key1:=.Range("A6"), order1:=xlAscending, Header:=xlGuess
                Range("A6:Q6").Borders.LineStyle = xlContinuous
                Range("A6:Q6").Borders.Weight = xlThin
            
       End With
              
    End If
    
    ThisWorkbook.Save
    
    'tell user what happened
    MsgBox msg, 48, msg
    
    Set C = Nothing
    
myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
Unload Me


End Sub


Sub ResetButtons(ByVal Status As Boolean)
    
    With Me.NewRecord
        .Caption = IIf(Status, "CANCEL", "ADD NEW CUSTOMER TO DATABASE")
        .BackColor = IIf(Status, &HFF&, &H8000000F)
        .ForeColor = IIf(Status, &HFFFFFF, &H0&)
        .Tag = Not Status
    Me.ComboBoxCustomersNames.Enabled = CBool(.Tag)
    End With
    
    With Me.UpdateRecord
        .Caption = IIf(Status, "SAVE NEW CUSTOMER TO DATABASE", "SAVE CHANGES FOR THIS CUSTOMER")
        .Tag = Status
    End With
End Sub




Sub Navigate(ByVal Direction As XlSearchDirection)
    Dim i As Integer
    Dim LastRow As Long
    
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    r = IIf(Direction = xlPrevious, r - 1, r + xlNext)
    
    'ensure value of r stays within data range
    If r < startRow Then r = startRow
    If r > LastRow Then r = LastRow
    
    'get record
    For i = 1 To UBound(ControlNames)
         Me.Controls(ControlNames(i)).Text = IIf(Direction = xlNone, "", ws.Cells(r, i).Text)
    Next i
    
    Me.Caption = "Database"
    
    'set enabled status of next previous buttons
    Me.NextRecord.Enabled = IIf(Direction = xlNone, False, r < LastRow)
    Me.PrevRecord.Enabled = IIf(Direction = xlNone, False, r > startRow)
    
    EventsEnable = False
    Me.ComboBoxCustomersNames.ListIndex = IIf(Direction = xlNone, -1, r - startRow)
    EventsEnable = True




End Sub


Private Sub UserForm_Initialize()
    Set ws = ThisWorkbook.Worksheets("Database")
    
    ComboBoxCustomersNames_Update




    ResetButtons False
    'start at first record
    Navigate Direction:=xlFirst
    
End Sub


[CODE]Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Range("A6", Cells(Rows.Count, "A").End(xlUp)), Target) Is Nothing Then Exit Sub
    Cancel = True
    Database.LoadData Me, Target.Row
End Sub
Private Sub HyperlinkButton_Click()
    Const FILE_PATH As String = "C:\Users\Ian\Desktop\Invoices\"
    
    If Len(Dir(FILE_PATH & ActiveCell.Value)) Then
        ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value
    End If
End Sub
Private Sub ComboBox1_Change()
  Dim r As Range
  Set r = Range("A5", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible) _
    .Find(ComboBox1.Value)
  If Not r Is Nothing Then r.Select
  ComboBox1.ListIndex = -1
End Sub
Private Sub ComboBox1_DropButt*******()
  RangeUniqueSortFillControl Range("A5", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible), Sheet18.ComboBox1
End Sub
Private Sub CustomerSort_Click()
    Dim x As Long
        Application.ScreenUpdating = False
        With Sheets("DATABASE")
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Range("A5:Q" & x).Sort key1:=Range("A6"), order1:=xlAscending, Header:=xlGuess
    End With
    ActiveWorkbook.Save
       Application.ScreenUpdating = True
    Sheets("DATABASE").Range("A6").Select
End Sub
Private Sub GoToLastRow_Click()
    Application.GoTo Sheets("DATABASE").Range("A" & Rows.Count).End(xlUp), True
    ActiveWindow.SmallScroll UP:=10
End Sub


Private Sub Image1_Click()
DatabaseInput.Show
End Sub


Private Sub InsertNewRow_Click()
Rows("6:6").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A6").Select
Range("A6:Q6").Borders.LineStyle = xlContinuous
Range("A6:Q6").Borders.Weight = xlThin
Range("A6:Q6").Interior.ColorIndex = 6
Range("M6") = Date
Range("$Q$6").Value = "'NO NOTES FOR THIS CUSTOMER"
Range("$Q$6").HorizontalAlignment = xlCenter
End Sub
Private Sub OpenDatabase_Click()
Database.Show
End Sub
Private Sub TopOfPage_Click()
Range("A6").Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Column = 13 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
        End If
    End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "Q"


'   *** Specify start row ***
    myStartRow = 6
    
'   Use first column to find the last row
    myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    myRange.Interior.ColorIndex = 6
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   Highlight the row and column that contain the active cell
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
Target.Interior.Color = vbGreen
    Application.ScreenUpdating = True


End Sub
Private Sub Worksheet_Activate()
Range("A6").Activate
End Sub

[/CODE]
 
Upvote 0
These too are module level variables...

Code: 
[COLOR=#333333] Dim ws As Worksheet
[/COLOR] Dim r As Long
 Dim EventsEnable As Boolean
 [COLOR=#333333] Const startRow As Long = 6[/COLOR]

So they need to go after Option Explicit and before your macros.
 
Upvote 0
Thanks,
It now opens & i need to check a few things out.

many thanks for the help & advice.

Be back tomorrow to complete this.

Have a nice day.
 
Upvote 0
Morning,
I have taken a look at this and very happy with how it works,many thanks.

One thing i have noticed is the save function now on the userform.

When i open the userform whether it be by clicking my database button or by using the new double click option i see like normal a button "save changes for this customer"
If i make an edit to anything in a text box where as before it would update & then saves it now pops up a compile error message,Variable not defined.
If i then click ok i am then taken to this part of the code
Code: 
x = .Cells(.Rows.Count, 1).End(xlUp).Row

I also see this part of the code shown in yello
Code: 
Private Sub UpdateRecord_Click()

Below is the code for the update button

Code: 
Private Sub UpdateRecord_Click()

Dim C As Range
Dim i As Integer
Dim msg As String
If Not IsComplete(Form:=Me) Then Exit Sub
Dim IsNewCustomer As Boolean
'New Part
 Dim ctrl As MSForms.Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is MSForms.TextBox Then ctrl.BackColor = RGB(255, 255, 255)
    Next ctrl
'End New part


    If Me.NewRecord.Caption = "CANCEL" Then
        With Sheets("DATABASE")
            Set C = .Range("A:A").Find(What:=txtCustomer.Value, _
                                After:=.Range("A5"), _
                                LookIn:=xlValues, _
                                lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
        End With
        If Not C Is Nothing Then
              MsgBox "Customer already Exists, file did not update"
              Cells(C.Row, "Q").Value = TextBox1 '<<<<<<<<<<<<<<
              Exit Sub
        End If
    End If
    
    IsNewCustomer = CBool(Me.UpdateRecord.Tag)
       
    msg = "CHANGES SAVED SUCCESSFULLY"
        
    If IsNewCustomer Then
    'New record - check all fields entered
        r = startRow
        msg = "NEW CUSTOMER SAVED TO DATABASE"
        ws.Range("A6").EntireRow.Insert
        ResetButtons Not IsNewCustomer
        Me.NextRecord.Enabled = True
    End If
    
        On Error GoTo myerror
    Application.EnableEvents = False
    'Add / Update Record
    For i = 1 To UBound(ControlNames)
                        With Me.Controls(ControlNames(i))
            'check if date value
            If IsDate(.Text) Then
                ws.Cells(r, i).Value = DateValue(.Text)
            ElseIf i = 15 Then
            If .Text = "" Then
                     MsgBox .Name & " is empty!"
                     Exit Sub
                End If
                ws.Cells(r, i).Value = Val(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11
                ws.Cells(r, "P").Font.Size = 16
        End With


    Next i
    
    If IsNewCustomer Then
        Call ComboBoxCustomersNames_Update
        Range("A6:Q6").Interior.ColorIndex = 6
        
        With Sheets("DATABASE")
            If .AutoFilterMode Then .AutoFilterMode = False
            x = .Cells(.Rows.Count, 1).End(xlUp).Row
                .Range("A5:Q" & x).Sort key1:=.Range("A6"), order1:=xlAscending, Header:=xlGuess
                Range("A6:Q6").Borders.LineStyle = xlContinuous
                Range("A6:Q6").Borders.Weight = xlThin
            
       End With
              
    End If
    
    ThisWorkbook.Save
    
    'tell user what happened
    MsgBox msg, 48, msg
    
    Set C = Nothing
    
myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
Unload Me


End Sub

Thanks
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Userform code to open UK post code within Google Maps
2
Replies
11
Views
271
ipbr21054
I
I
  • Solved
Textbox on userform not updating when navigating through records
2
Replies
10
Views
525
ipbr21054
I
I
  • Solved
Load into textbox two values from customer on worksheet
Replies
6
Views
105
AlphaFrog
AlphaFrog
I
  • Solved
Advice to change or speed up the way this code operates at present
Replies
8
Views
121
ipbr21054
I
I
  • Question Question
Use the majority of an existing working code in new project advice
Replies
1
Views
221
ipbr21054
I

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top