Adding New Entries From The Top

Hi All,

I am creating a Userform which makes it easy to store certain details about past customers.

The idea is that this data is as easy to enter as possible, hence the Userform.

The Userform automatically loads when the Worksheet/File is opened, meaning it is just a simple type in and click 'Add Details'.
The Userform loads over the button which you can see in the Worksheet, I just put a button there so if you close the Userform you can re-open it by clicking the button.

Entry Form.png
Spreadsheet.png


At the moment the data is set to enter into the next empty row, but I've now changed my mind and would now like the data to be entered in the top row.

The reason for this is so that you can easily see it by the side of the userform and check to make sure it is correct.

So basically I want it so the newest entry is on the top row, which means that the older the entry, the further down it will be.


My current codeing for the 'Add Details' Command Button is :

Formula:

Private Sub Cmdbutton_add_Click()

Dim iRow As Long

Dim ws As Worksheet

Set ws = Worksheets("EmailDatabase")



'find first empty row in database

iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _

    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1



'check for a first name

If Trim(Me.FirstNameTextBox.Value) = "" Then

  Me.FirstNameTextBox.SetFocus

  MsgBox "Please enter a first name"

  Exit Sub

End If



'check for a email address

If Trim(Me.EmailAddressTextBox.Value) = "" Then

  Me.EmailAddressTextBox.SetFocus

  MsgBox "Please enter a email address"

  Exit Sub

End If



'copy the data to the database

'use protect and unprotect lines,

'     with your password

'     if worksheet is protected

With ws

'  .Unprotect Password:="password"

  .Cells(iRow, 1).Value = Me.FirstNameTextBox.Value

  .Cells(iRow, 2).Value = Me.LastNameTextBox.Value

  .Cells(iRow, 3).Value = Me.CompanyNameTextBox.Value

  .Cells(iRow, 4).Value = Me.EmailAddressTextBox.Value

  .Cells(iRow, 5).Value = Me.TelephoneNumberTextBox.Value

'  .Protect Password:="password"

End With



'clear the data

Me.FirstNameTextBox.Value = ""

Me.LastNameTextBox.Value = ""

Me.CompanyNameTextBox.Value = ""

Me.EmailAddressTextBox.Value = ""

Me.TelephoneNumberTextBox.Value = ""



If StagOptionButton.Value = True Then

    Cells(iRow, 6).Value = "Stag"

End If



If HenOptionButton.Value = True Then

    Cells(iRow, 6).Value = "Hen"

End If



If CorporateOptionButton.Value = True Then

    Cells(iRow, 6).Value = "Corporate"

End If



If TeamBuildingOptionButton.Value = True Then

    Cells(iRow, 6).Value = "Team Building"

End If

If ActivityWeekendOptionButton.Value = True Then

    Cells(iRow, 6).Value = "Activity Weekend"

End If

If LocalGroupOptionButton.Value = True Then

    Cells(iRow, 6).Value = "Local Group"

End If

If LocalCompanyOptionButton.Value = True Then

    Cells(iRow, 6).Value = "Local Company"

End If

If OtherOptionButton.Value = True Then

    Cells(iRow, 6).Value = "Other"

End If



End Sub

I'm fairly new to all this Excel VBA, and what I've created above is a result of many hours of searching the internet - unfortunately I can't find anything for what I know want.

Any help would be very much appreciated!

Many Thanks,

James

James - I think this should work:

Private Sub Cmdbutton_add_Click()

Dim ws As Worksheet

Set ws = Worksheets("EmailDatabase")

'check for a first name
If Trim(Me.FirstNameTextBox.Value) = "" Then
  Me.FirstNameTextBox.SetFocus
  MsgBox "Please enter a first name"
  Exit Sub
End If

'check for a email address
If Trim(Me.EmailAddressTextBox.Value) = "" Then
  Me.EmailAddressTextBox.SetFocus
  MsgBox "Please enter a email address"
  Exit Sub
End If

'copy the data to the database
'use protect and unprotect lines,
'     with your password
'     if worksheet is protected
With ws
'  .Unprotect Password:="password"
  .Cells(1, 1).Resize(, 6).Insert shift:=xlDown
  .Cells(2, 1).Value = Me.FirstNameTextBox.Value
  .Cells(2, 2).Value = Me.LastNameTextBox.Value
  .Cells(2, 3).Value = Me.CompanyNameTextBox.Value
  .Cells(2, 4).Value = Me.EmailAddressTextBox.Value
  .Cells(2, 5).Value = Me.TelephoneNumberTextBox.Value
'  .Protect Password:="password"
End With

'clear the data
Me.FirstNameTextBox.Value = ""
Me.LastNameTextBox.Value = ""
Me.CompanyNameTextBox.Value = ""
Me.EmailAddressTextBox.Value = ""
Me.TelephoneNumberTextBox.Value = ""

If StagOptionButton.Value = True Then
    Cells(2, 6).Value = "Stag"
End If

If HenOptionButton.Value = True Then
    Cells(2, 6).Value = "Hen"
End If

If CorporateOptionButton.Value = True Then
    Cells(2, 6).Value = "Corporate"
End If

If TeamBuildingOptionButton.Value = True Then
    Cells(2, 6).Value = "Team Building"
End If

If ActivityWeekendOptionButton.Value = True Then
    Cells(2, 6).Value = "Activity Weekend"
End If

If LocalGroupOptionButton.Value = True Then
    Cells(2, 6).Value = "Local Group"
End If

If LocalCompanyOptionButton.Value = True Then
    Cells(2, 6).Value = "Local Company"
End If

If OtherOptionButton.Value = True Then
    Cells(2, 6).Value = "Other"
End If

End Sub

Here is a screenshot to show what I mean :

Excel Example.png

Hi Stephen,

Thanks for the quick reply! I am afraid the above doesn't seem to work.

I copied the code and replaced my previous code, but when I click the 'Add Details' button, nothing happens.

No details appear on the WorkSheet, and the fields don't clear either.

Many Thanks.

James

Originally Posted by Jimbob 2705

Hi Stephen,

Thanks for the quick reply! I am afraid the above doesn't seem to work.

I copied the code and replaced my previous code, but when I click the 'Add Details' button, nothing happens.

No details appear on the WorkSheet, and the fields don't clear either.

Many Thanks.

James

Apologies Stephen - it appears I copied the details wrong!!!

The 'Add Details' button now works, but unfortunately the issue now is that the first entry replaces my 'Menu' (When I say Menu, I mean by Title), and then it pushes my Titles down the page as you add more entries.

Is it possible to keep the Titles at the very top?

Many Thanks,

James

Are your titles in row 1 or row 2?

In the code I posted, try adding 1 to the first parameter in all instances of Cells , e.g. Cells(1,1) becomes Cells (2,1).

Originally Posted by StephenR

Are your titles in row 1 or row 2?

Titles are in Row 1 Stephen. (Have a look at the second attachment in post 1)

Originally Posted by StephenR

In the code I posted, try adding 1 to the first parameter in all instances of Cells , e.g. Cells(1,1) becomes Cells (2,1).

I'll try that now.

Thanks once again,

James

Originally Posted by StephenR

In the code I posted, try adding 1 to the first parameter in all instances of Cells , e.g. Cells(1,1) becomes Cells (2,1).

I did that Stephen, and its getting closer to being right, but its still not quite there.

The first entry is starting on Row 3 instead of Row 2 (no big deal) but it is making Row 2 have a grey background.

It worked in that it started a new row above, but the issue is that it's then copying the Titles format/style (Grey background, bold text, centered text)

I've attached my document as I thought it would be easier for you to work on : Email Database.xlsm

I am trying to upload my screenshots of the problem, but the uploader is playing up for some reason

Thanks again,

James

Entry 1+2.png

Hopefully that should explain my issue.

Silly me. After the "With ws" line, change the first line and add the second:

  .Cells(2, 1).Resize(, 6).Insert shift:=xlDown
  .Cells(2, 1).Resize(, 6).Interior.Color = xlNone

That's perfect Stephen - Thanks for that!

One slight little niggle - the entries are in bold and centered (basically copying the titles I assume, minus the grey background).

Is there anyway to stop this?

Many Thanks - I really appreciate it!

James

James - try this, which will also stop the flickering:

Private Sub Cmdbutton_add_Click()

Dim ws As Worksheet

Application.ScreenUpdating = False

Set ws = Worksheets("EmailDatabase")

'check for a first name
If Trim(Me.FirstNameTextBox.Value) = "" Then
  Me.FirstNameTextBox.SetFocus
  MsgBox "Please enter a first name"
  Exit Sub
End If

'check for a email address
If Trim(Me.EmailAddressTextBox.Value) = "" Then
  Me.EmailAddressTextBox.SetFocus
  MsgBox "Please enter a email address"
  Exit Sub
End If

'copy the data to the database
'use protect and unprotect lines,
'     with your password
'     if worksheet is protected
With ws
'  .Unprotect Password:="password"
  .Cells(2, 1).Resize(, 6).Insert shift:=xlDown
  With .Cells(2, 1).Resize(, 6)
    .Interior.Color = xlNone
    .Font.Bold = False
    .HorizontalAlignment = xlLeft
  End With
  .Cells(2, 1).Value = Me.FirstNameTextBox.Value
  .Cells(2, 2).Value = Me.LastNameTextBox.Value
  .Cells(2, 3).Value = Me.CompanyNameTextBox.Value
  .Cells(2, 4).Value = Me.EmailAddressTextBox.Value
  .Cells(2, 5).Value = Me.TelephoneNumberTextBox.Value
'  .Protect Password:="password"
End With

'clear the data
Me.FirstNameTextBox.Value = ""
Me.LastNameTextBox.Value = ""
Me.CompanyNameTextBox.Value = ""
Me.EmailAddressTextBox.Value = ""
Me.TelephoneNumberTextBox.Value = ""

If StagOptionButton.Value = True Then
    Cells(2, 6).Value = "Stag"
End If

If HenOptionButton.Value = True Then
    Cells(2, 6).Value = "Hen"
End If

If CorporateOptionButton.Value = True Then
    Cells(2, 6).Value = "Corporate"
End If

If TeamBuildingOptionButton.Value = True Then
    Cells(2, 6).Value = "Team Building"
End If

If ActivityWeekendOptionButton.Value = True Then
    Cells(2, 6).Value = "Activity Weekend"
End If

If LocalGroupOptionButton.Value = True Then
    Cells(2, 6).Value = "Local Group"
End If

If LocalCompanyOptionButton.Value = True Then
    Cells(2, 6).Value = "Local Company"
End If

If OtherOptionButton.Value = True Then
    Cells(2, 6).Value = "Other"
End If

Application.ScreenUpdating = True

End Sub

Stephen - Thankyou ever so much, that works perfectly.

Just a thought, would it be possible to make it so an Option Button has to be selected in order to Add Details?

I've already done this for the First Name and Email Address, but I don't know how it works with Option Buttons.

Oh, and possibly clear the options for each entry, again I've done this for the text fields, but I'm unsure on the option buttons.

Basically so when you click add details, every field clears so it's like looking at a new form?

Many Thanks,

James

James - I think that probably counts as a different question so I suggest you start a new thread and can link to this one.

Originally Posted by StephenR

James - I think that probably counts as a different question so I suggest you start a new thread and can link to this one.

Ok, Thanks for all your help Stephen!