Excel VBA - Multiple Issues for a newbie.

C

Cameron

Hi all,
This is my first VBA Projet and whilst it works (in it's current stat
/ content), I've stumbled across some problems.
So if you are willing to amble through my ramblings and assist, I'll b
greatfully apreciative of any suggestion / solutions you are willing t
offer.

The Named Array's: 'Doctors' / 'Doctors Array' / 'Doctors Table' al
have data in them currently. And when using the 'RemoveButton' wil
successfully remove all records. But when I attempt to add a recor
fails due to the 'Doctors' Named Array being a #REF error due to th
last record being removed (so I'd concluded).

I attempted to add a dummy record and retried to add a record, but i
again fell over as (-and I'm assuming here again-) due to not enoug
records for the script to work.

My questions are: a
- Do I need to re-write what I've completed thus far ?
- Need to build a user function to handle this problem?
- Have I overlooked some basic fundamentals in the design of th
script?
- Is my existing code well structured??
- Areas of improvement ??
- Need to see a shrink?aAgain any help is apreciated.
-If anyone would like a copy of the XLS to view, let me know.-

Cheers,
Cameron
-Brisbane, Australia-

------------------------------------------------
Code in Worksheet "*Extra Tables*"...

Code
-------------------
Private Sub AddButton_Click()
'ADD DOCTOR
DisableButtons
frmGetDetails.Show
ShowButtons
End Sub

Private Sub DeleteButton_Click()
'REMOVE DOCTOR !!
DisableButtons
frmDltDetails.Show
ShowButtons
End Sub

Public Sub DisableButtons()
CommandButton1.Enabled = False
CommandButton3.Enabled = False
ThisWorkbook.Worksheets("Extra Tables").Range("A1").Select
End Sub

Public Sub ShowButtons()
CommandButton1.Enabled = True
CommandButton3.Enabled = True
ThisWorkbook.Worksheets("Extra Tables").Range("A1").Select
End Su
-------------------
Code in Userform *frmGetDetails*...

Code
-------------------
Sub ClearText()
'Sub to clear values of all TextBox's
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
End Sub

Private Sub CancelButton_Click()
'Hide this form & unload
Me.Hide
Unload Me
End Sub

Private Sub ContinueButton_Click()

Select Case Len(TextBox1.Text)
Case 0
MsgBox "Information Required - Doctors Name." & vbCrLf & _
"This field cannot remain empty.", vbInformation, "Missing Data!"
ContinueButton.Enabled = False
TextBox1.SetFocus
'Drop out of this Sub
Exit Sub
End Select

Select Case Len(TextBox2.Text)
Case 0
MsgBox "Information Required - Brief Detail." & vbCrLf & _
"This field cannot remain empty.", vbInformation, "Missing Data!"
TextBox2.SetFocus
'Drop out of this Sub
Exit Sub
End Select

Select Case Len(TextBox3.Text)
Case 0
MsgBox "Information Required - Address Line 1 Details." & vbCrLf & _
"This field cannot remain empty.", vbInformation, "Missing Data!"
TextBox3.SetFocus
'Drop out of this Sub
Exit Sub
Case Else
Select Case Len(TextBox4.Text)
Case 0
Resp1 = MsgBox("Information Required - Address Line 2 Details." & vbCrLf & _
"Are you sure this line is to be empty?", vbYesNo, "Missing Data!")
If Resp1 = vbNo Then
TextBox4.SetFocus
'Drop out of this Sub
Exit Sub
End If
Case Else
Select Case Len(TextBox5.Text)
Case 0
Resp1 = MsgBox("Information Required - Address Line 3 Details." & _
vbCrLf & "Are you sure this line is to be empty?", vbYesNo, "Missing Data!")
If Resp1 = vbNo Then
TextBox5.SetFocus
'Drop out of this Sub
Exit Sub
End If
End Select
End Select
End Select

'Prompt User with a Message Dialog Box to confirm details.
Resp2 = MsgBox("Please confirn the following details:" & vbTab & vbCrLf & _
"Doctors Name:" & vbTab & TextBox1.Text & "." & vbTab & vbCrLf & _
"Brief Detail:" & vbTab & TextBox2.Text & "." & vbTab & vbCrLf & _
"Address Details:" & vbCrLf & _
vbTab & vbTab & TextBox3.Text & vbCrLf & _
vbTab & vbTab & TextBox4.Text & vbCrLf & _
vbTab & vbTab & TextBox5.Text & vbCrLf & _
vbTab & vbTab & TextBox6.Text, vbYesNo, "Confirm Details Entered.")

If Resp2 = vbYes Then
' Perform AddData Sub
AddData
End If
' Hide this form & unload
Me.Hide
Unload Me

End Sub

Sub AddData()

Dim strVal As String

' Work out what is the last row number under the `Doctors` Named Array.
LastRow = ThisWorkbook.Worksheets("Extra Tables").Range("Doctors").End(xlDown).Row + 1
' Go to last row and insert an entire row.
ThisWorkbook.Worksheets("Extra Tables").Range("F" & LastRow).Select
Selection.EntireRow.Insert
' Insert New Doctor Details
ThisWorkbook.Worksheets("Extra Tables").Range("F" & LastRow).Select
ActiveCell.Value = TextBox1.Text
ThisWorkbook.Worksheets("Extra Tables").Range("G" & LastRow).Select
ActiveCell.Value = TextBox2.Text
ThisWorkbook.Worksheets("Extra Tables").Range("H" & LastRow).Select
' TextBox3.Text (Address Line 1) has to have some value before getting to this point,
' so include it into strVal now.
strVal = TextBox3.Text
' Add remaining Address Lines are required.
If TextBox4.Text <> "" Then _
strVal = strVal & vbLf & TextBox4.Text
If TextBox5.Text <> "" Then _
strVal = strVal & vbLf & TextBox5.Text
If TextBox6.Text <> "" Then _
strVal = strVal & vbLf & TextBox6.Text
'Post Address Lines to ActiveCell
ActiveCell.Value = strVal

' SORT `DoctorsTable` Array
ThisWorkbook.Worksheets("Extra Tables").Range("F15:H" & LastRow).Sort _
Key1:=Range("F15"), Order1:=xlAscending, Key2:=Range("G15"), _
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
' Rebuild Named Ranges that have been expanded.
ActiveWorkbook.Names.Add Name:="Doctors", _
RefersTo:="='Extra Tables'!$F$15:$F$" & LastRow
ActiveWorkbook.Names.Add Name:="DoctorsArray", _
RefersTo:="='Extra Tables'!$F$15:$G$" & LastRow
ActiveWorkbook.Names.Add Name:="DoctorsTable", _
RefersTo:="='Extra Tables'!$F$15:$H$" & LastRow
End Sub

Private Sub TextBox1_Change()
' Ensure Doctors Name
If Len(TextBox1.Text) >= 0 And IsNumeric(VBA.Left(TextBox1.Text, 1)) = False Then
If Len(TextBox2.Text) > 0 Then
If Len(TextBox3.Text) > 0 Then
ContinueButton.Enabled = True
Else
ContinueButton.Enabled = False
End If
Else
ContinueButton.Enabled = False
End If
Else
MsgBox "Docors Names generally don't start with numbers.", _
vbOKOnly, "Incorrect Details !!"
TextBox1.Text = ""
TextBox1.SetFocus
ContinueButton.Enabled = False
End If
End Sub

Private Sub TextBox2_Change()
If Len(TextBox1.Text) >= 0 And IsNumeric(VBA.Left(TextBox1.Text, 1)) = False Then
If Len(TextBox2.Text) > 0 Then
If Len(TextBox3.Text) > 0 Then
ContinueButton.Enabled = True
Else
ContinueButton.Enabled = False
End If
Else
ContinueButton.Enabled = False
End If
Else
ContinueButton.Enabled = False
End If
End Sub

Private Sub TextBox3_Change()

If Len(TextBox1.Text) >= 0 And IsNumeric(VBA.Left(TextBox1.Text, 1)) = False Then
If Len(TextBox2.Text) > 0 Then
If Len(TextBox3.Text) > 0 Then
ContinueButton.Enabled = True
Else
ContinueButton.Enabled = False
End If
Else
ContinueButton.Enabled = False
End If
Else
ContinueButton.Enabled = False
End If
End Sub

Private Sub Userform_Activate()
ClearText
TextBox1.SetFocus
ContinueButton.Enabled = False
End Sub
 
S

steve smallman

Cameron,
What you've got so far looks good ( a couple of issues
with the construction of your If statements, particularly
in the textbox changes).

Have a look at the CurrentRegion and Rows properties.

If you add a line to check the number of rows in your
named range, then you can perhaps avoid the issues you
have highlighted.

A full analysis of your code is not really possible here,
but if you send me the workbook (hold the size under 400k
), I'll go over it and send it back with comments. My
email is (e-mail address removed) without the
nospam.

Your code seems to be worthwhile as it stands, don't throw
it out (there is a school of thought that code should
never be discarded if it works, any code can be recycled,
and recycling is a good thing).

You have retained the Excel default naming of the
controls on your userform. While it may be simple enough
in this application, you chould seriously consider using
descriptive names for controls, e.g. txtDoctorName.
This will let you know the type of control, and the data
it should contain. Similarly the prefixes cbo, lst, cmd
or btn, chk and opt are commonly used for combobox,
listbox, command button, check box and option box
controls.

A nested If Then statement doesn't need its own Else.
If logical_test1 Then
If Logical_Test2 then
If logical_test3 Then
Do_something
Else
Do_something_different
End if
End if
end if

Note the use of indenting to simplify reading code.

Also, I note you have used And in one line of your if
statements, is there a reason why you didn't concatenate
multiple Ands?

If Logical_test1 AND Logical_test2 AND Logical_test3 Then
Do_something
Else
Do_something_else
End If

Hope this is of use to you

Steve





-----Original Message-----
Hi all,
This is my first VBA Projet and whilst it works (in it's current state
/ content), I've stumbled across some problems.
So if you are willing to amble through my ramblings and assist, I'll be
greatfully apreciative of any suggestion / solutions you are willing to
offer.

The Named Array's: 'Doctors' / 'Doctors Array' / 'Doctors Table' all
have data in them currently. And when using the 'RemoveButton' will
successfully remove all records. But when I attempt to add a record
fails due to the 'Doctors' Named Array being a #REF error due to the
last record being removed (so I'd concluded).

I attempted to add a dummy record and retried to add a record, but it
again fell over as (-and I'm assuming here again-) due to not enough
records for the script to work.

My questions are: a
- Do I need to re-write what I've completed thus far ?
- Need to build a user function to handle this problem?
- Have I overlooked some basic fundamentals in the design of the
script?
- Is my existing code well structured??
- Areas of improvement ??
- Need to see a shrink?aAgain any help is apreciated.
-If anyone would like a copy of the XLS to view, let me know.-

Cheers,
Cameron
-Brisbane, Australia-

-------------------------------------------------
Code in Worksheet "*Extra Tables*"...

Code:
--------------------
Private Sub AddButton_Click()
'ADD DOCTOR
DisableButtons
frmGetDetails.Show
ShowButtons
End Sub

Private Sub DeleteButton_Click()
'REMOVE DOCTOR !!
DisableButtons
frmDltDetails.Show
ShowButtons
End Sub

Public Sub DisableButtons()
CommandButton1.Enabled = False
CommandButton3.Enabled = False
ThisWorkbook.Worksheets("Extra Tables").Range ("A1").Select
End Sub

Public Sub ShowButtons()
CommandButton1.Enabled = True
CommandButton3.Enabled = True
ThisWorkbook.Worksheets("Extra Tables").Range ("A1").Select
End Sub
--------------------
Code in Userform *frmGetDetails*...

Code:
--------------------
Sub ClearText()
'Sub to clear values of all TextBox's
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
End Sub

Private Sub CancelButton_Click()
'Hide this form & unload
Me.Hide
Unload Me
End Sub

Private Sub ContinueButton_Click()

Select Case Len(TextBox1.Text)
Case 0
MsgBox "Information Required - Doctors Name." & vbCrLf & _
"This field cannot remain empty.", vbInformation, "Missing Data!"
ContinueButton.Enabled = False
TextBox1.SetFocus
'Drop out of this Sub
Exit Sub
End Select

Select Case Len(TextBox2.Text)
Case 0
MsgBox "Information Required - Brief Detail." & vbCrLf & _
"This field cannot remain empty.", vbInformation, "Missing Data!"
TextBox2.SetFocus
'Drop out of this Sub
Exit Sub
End Select

Select Case Len(TextBox3.Text)
Case 0
MsgBox "Information Required - Address Line 1 Details." & vbCrLf & _
"This field cannot remain empty.", vbInformation, "Missing Data!"
TextBox3.SetFocus
'Drop out of this Sub
Exit Sub
Case Else
Select Case Len(TextBox4.Text)
Case 0
Resp1 = MsgBox("Information Required - Address Line 2 Details." & vbCrLf & _
"Are you sure this line is to be empty?", vbYesNo, "Missing Data!")
If Resp1 = vbNo Then
TextBox4.SetFocus
'Drop out of this Sub
Exit Sub
End If
Case Else
Select Case Len(TextBox5.Text)
Case 0
Resp1 = MsgBox("Information Required - Address Line 3 Details." & _
vbCrLf & "Are you sure this line is to be empty?", vbYesNo, "Missing Data!")
If Resp1 = vbNo Then
TextBox5.SetFocus
'Drop out of this Sub
Exit Sub
End If
End Select
End Select
End Select

'Prompt User with a Message Dialog Box to confirm details.
Resp2 = MsgBox("Please confirn the following details:" & vbTab & vbCrLf & _
"Doctors Name:" & vbTab & TextBox1.Text & "." & vbTab & vbCrLf & _
"Brief Detail:" & vbTab & TextBox2.Text & "." & vbTab & vbCrLf & _
"Address Details:" & vbCrLf & _
vbTab & vbTab & TextBox3.Text & vbCrLf & _
vbTab & vbTab & TextBox4.Text & vbCrLf & _
vbTab & vbTab & TextBox5.Text & vbCrLf & _
vbTab & vbTab & TextBox6.Text, vbYesNo, "Confirm Details Entered.")

If Resp2 = vbYes Then
' Perform AddData Sub
AddData
End If
' Hide this form & unload
Me.Hide
Unload Me

End Sub

Sub AddData()

Dim strVal As String

' Work out what is the last row number under the `Doctors` Named Array.
LastRow = ThisWorkbook.Worksheets("Extra Tables").Range
Click to expand...
("Doctors").End(xlDown).Row + 1
' Go to last row and insert an entire row.
ThisWorkbook.Worksheets("Extra Tables").Range("F" & LastRow).Select
Selection.EntireRow.Insert
' Insert New Doctor Details
ThisWorkbook.Worksheets("Extra Tables").Range("F" & LastRow).Select
ActiveCell.Value = TextBox1.Text
ThisWorkbook.Worksheets("Extra Tables").Range("G" & LastRow).Select
ActiveCell.Value = TextBox2.Text
ThisWorkbook.Worksheets("Extra Tables").Range("H" & LastRow).Select
' TextBox3.Text (Address Line 1) has to have some
Click to expand...
value before getting to this point,
' so include it into strVal now.
strVal = TextBox3.Text
' Add remaining Address Lines are required.
If TextBox4.Text <> "" Then _
strVal = strVal & vbLf & TextBox4.Text
If TextBox5.Text <> "" Then _
strVal = strVal & vbLf & TextBox5.Text
If TextBox6.Text <> "" Then _
strVal = strVal & vbLf & TextBox6.Text
'Post Address Lines to ActiveCell
ActiveCell.Value = strVal

' SORT `DoctorsTable` Array
ThisWorkbook.Worksheets("Extra Tables").Range("F15:H" & LastRow).Sort _
Key1:=Range("F15"), Order1:=xlAscending, Key2:=Range ("G15"), _
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
' Rebuild Named Ranges that have been expanded.
ActiveWorkbook.Names.Add Name:="Doctors", _
RefersTo:="='Extra Tables'!$F$15:$F$" & LastRow
ActiveWorkbook.Names.Add Name:="DoctorsArray", _
RefersTo:="='Extra Tables'!$F$15:$G$" & LastRow
ActiveWorkbook.Names.Add Name:="DoctorsTable", _
RefersTo:="='Extra Tables'!$F$15:$H$" & LastRow
End Sub

Private Sub TextBox1_Change()
' Ensure Doctors Name
If Len(TextBox1.Text) >= 0 And IsNumeric(VBA.Left
Click to expand...
(TextBox1.Text, 1)) = False Then
If Len(TextBox2.Text) > 0 Then
If Len(TextBox3.Text) > 0 Then
ContinueButton.Enabled = True
Else
ContinueButton.Enabled = False
End If
Else
ContinueButton.Enabled = False
End If
Else
MsgBox "Docors Names generally don't start with numbers.", _
vbOKOnly, "Incorrect Details !!"
TextBox1.Text = ""
TextBox1.SetFocus
ContinueButton.Enabled = False
End If
End Sub

Private Sub TextBox2_Change()
If Len(TextBox1.Text) >= 0 And IsNumeric(VBA.Left
Click to expand...
(TextBox1.Text, 1)) = False Then
If Len(TextBox2.Text) > 0 Then
If Len(TextBox3.Text) > 0 Then
ContinueButton.Enabled = True
Else
ContinueButton.Enabled = False
End If
Else
ContinueButton.Enabled = False
End If
Else
ContinueButton.Enabled = False
End If
End Sub

Private Sub TextBox3_Change()

If Len(TextBox1.Text) >= 0 And IsNumeric(VBA.Left
Click to expand...
(TextBox1.Text, 1)) = False Then
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
Force proper case on user form text box 7
Userform to update rows of data 4
Using a button to scroll Up & Down a Database on a Userform 0
VBA Export to PDF 0
Create a public variable 5
Arbitrary data to Textboxes in UserForm 4

Top