userform with formulas

daffy

Board Regular
Joined
Mar 18, 2009
Messages
113
Hi All

Im stuck.
I have build a userform that works great on the blank sheet i have built it on.
The form is for entering data and always looks for the first blank line.

However if i add formulas to the blank lines the userform thinks this as a non blank line and moves down to the first completly blank line.

What i need is for the code to ignore the formulas and load the data to that line.

when i copy the userform to the sheet that it was made for i get an
error 9 message when i try to add any data

Thanks in advanced of any help
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
ok here is the code for the form.

Any Help Please.


Private Sub cmdcancel_Click()
Unload Me
End Sub
Private Sub cmdclear_Click()
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Then
ctl.Value = ""
End If
Next ctl
End Sub
Private Sub cmdok_Click()
ActiveSheet.Unprotect "aa"
Dim RowCount As Long
If Me.txtname.Value = "" Then
MsgBox "Please enter Name, Surname First"
Me.txtname.SetFocus
Exit Sub
End If
If Me.txtnumber.Value = "" Then
MsgBox "Please enter the Digi Card Number"
Me.txtnumber.SetFocus
Exit Sub
End If
If Me.txtcardrenewal.Value = "" Then
MsgBox "Please Enter The Renewal Date"
Me.txtcardrenewal.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtcardrenewal.Value) Then
MsgBox "The Card Renewal Must Be A Date", vbExclamation, "New Driver"
Me.txtcardrenewal.SetFocus
Exit Sub
End If
If Me.txtdob.Value = "" Then
MsgBox "Please Enter DOB"
Me.txtdob.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtdob.Value) Then
MsgBox "DOB Must Contain A Date", vbExclamation, "New Driver"
Me.txtdob.SetFocus
Exit Sub
End If
If Me.txtpicture.Value = "" Then
MsgBox "Please enter A Date"
Me.txtpicture.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtpicture.Value) Then
MsgBox "Picture Renewal Must Be A Date", vbExclamation, "New Driver"
Me.txtpicture.SetFocus
Exit Sub
End If
If Me.txtlicnum.Value = "" Then
MsgBox "Please enter a licence number"
Me.txtlicnum.SetFocus
Exit Sub
End If
If Me.txtgroup.Value = "" Then
MsgBox "Please enter a Group IE C+E Or Car"
Me.txtgroup.SetFocus
Exit Sub
End If
RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Sheet1").Range("A1")
.Offset(RowCount, 0).Value = Me.txtname.Value
.Offset(RowCount, 1).Value = Me.txtnumber.Value
.Offset(RowCount, 2).Value = Me.txtcardrenewal.Value
.Offset(RowCount, 3).Value = Me.txtdob.Value
.Offset(RowCount, 4).Value = Me.txtpicture.Value
.Offset(RowCount, 5).Value = Me.txtlicnum
.Offset(RowCount, 8).Value = Me.txtgroup.Value
End With
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Then
ctl.Value = ""
End If
Next ctl
ActiveSheet.Protect "aa"
End Sub
 
Upvote 0
Private Sub cmdcancel_Click()
Unload Me
End Sub

Private Sub cmdclear_Click()
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Then
ctl.Value = ""
End If
Next ctl
End Sub

Private Sub cmdok_Click()
ActiveSheet.Unprotect "aa"

Dim RowCount As Long

If Me.txtname.Value = "" Then
MsgBox "Please enter Name, Surname First"
Me.txtname.SetFocus
Exit Sub
End If
If Me.txtnumber.Value = "" Then
MsgBox "Please enter the Digi Card Number"
Me.txtnumber.SetFocus
Exit Sub
End If
If Me.txtcardrenewal.Value = "" Then
MsgBox "Please Enter The Renewal Date"
Me.txtcardrenewal.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtcardrenewal.Value) Then
MsgBox "The Card Renewal Must Be A Date", vbExclamation, "New Driver"
Me.txtcardrenewal.SetFocus
Exit Sub
End If
If Me.txtdob.Value = "" Then
MsgBox "Please Enter DOB"
Me.txtdob.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtdob.Value) Then
MsgBox "DOB Must Contain A Date", vbExclamation, "New Driver"
Me.txtdob.SetFocus
Exit Sub
End If
If Me.txtpicture.Value = "" Then
MsgBox "Please enter A Date"
Me.txtpicture.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtpicture.Value) Then
MsgBox "Picture Renewal Must Be A Date", vbExclamation, "New Driver"
Me.txtpicture.SetFocus
Exit Sub
End If
If Me.txtlicnum.Value = "" Then
MsgBox "Please enter a licence number"
Me.txtlicnum.SetFocus
Exit Sub
End If
If Me.txtgroup.Value = "" Then
MsgBox "Please enter a Group IE C+E Or Car"
Me.txtgroup.SetFocus
Exit Sub
End If
RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Sheet1").Range("A1")
.Offset(RowCount, 0).Value = Me.txtname.Value
.Offset(RowCount, 1).Value = Me.txtnumber.Value
.Offset(RowCount, 2).Value = Me.txtcardrenewal.Value
.Offset(RowCount, 3).Value = Me.txtdob.Value
.Offset(RowCount, 4).Value = Me.txtpicture.Value
.Offset(RowCount, 5).Value = Me.txtlicnum
.Offset(RowCount, 8).Value = Me.txtgroup.Value
End With
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Then
ctl.Value = ""
End If
Next ctl
ActiveSheet.Protect "aa"
End Sub
 
Upvote 0
I understand what is going on. Is the last row the only line with a formula?

if it is this may work

Code:
RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
If Application.WorksheetFunction.IsText(Range("A1").Offset(RowCount - 1, 0)) = True Then
  RowCount = RowCount - 1
End If
With Worksheets("Sheet1").Range("A1")
.Offset(RowCount, 0).Value = Me.txtname.Value
.Offset(RowCount, 1).Value = Me.txtnumber.Value
.Offset(RowCount, 2).Value = Me.txtcardrenewal.Value
.Offset(RowCount, 3).Value = Me.txtdob.Value
.Offset(RowCount, 4).Value = Me.txtpicture.Value
.Offset(RowCount, 5).Value = Me.txtlicnum
.Offset(RowCount, 8).Value = Me.txtgroup.Value
End With

If you need to test for multiple rows of formulas then you'll need some new code. I can help if you give more info. By the way, it helps if you put your code surrounded by CODE statements The word CODE within square brackets "[]" and the /CODE at the end of your code within square brackets "[]"

Jeff
 
Upvote 0
You could change the line that defines RowCount
Code:
With Worksheets("Sheet1").Range("A1").
    RowCount = .Find(What:="?*",After:=.Cells(1, 1), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
End with
 
Upvote 0
I made a mistake on that last one

Change this line:
If Application.WorksheetFunction.IsText(Range("A1").Offset(RowCount - 1, 0)) = True Then

To this line:
If Application.WorksheetFunction.IsText(Range("A1").Offset(RowCount - 1, 0)) = False Then


If you have multiple lines of formulas or if you want to revamp the code, try this:


Code:
'This needs to go at the top of the Sub
Dim Beg As Range, R As Range, Cell As Range

Set Beg = Worksheets("Sheet1").Range("A1")
Set R = Beg.CurrentRegion

For Each Cell In R
  If Application.WorksheetFunction.IsText(Cell) = False Then
    Cell = Me.txtname.Value
    Cell.Offset(0, 1) = Me.txtnumber.Value
    Cell.Offset(0, 2) = Me.txtcardrenewal.Value
    Cell.Offset(0, 3) = Me.txtdob.Value
    Cell.Offset(0, 4) = Me.txtpicture.Value
    Cell.Offset(0, 5) = Me.txtlicnum
    Cell.Offset(0, 6) = Me.txtgroup.Value
    Exit For
  End If
Next Cell
 
Upvote 0
Thanks guys.
I'm not in front of the sheet right now but the basics are.
For example I have 6 columbs that have formulas in all the way down to about row
250.
These are not populated by the userform though.

If that helps you understand me any better.
I hope I have explained it right to you both

Thanks for your help so far

Don
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,044
Members
448,543
Latest member
MartinLarkin

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