Userform help please

C

Chris Hankin

Hello, could someone please help me with a Userform?

I need to create a Userform that asks the user the enter information in
the following fields:

Finance File No:
Full Name:
FY:
Date of Request:
Category:
WBS Element No:
Cost Centre Code:
How Many New Lines:

Please note that the Category field needs to be a a drop-down selection
box.

The data for the Category field is on a table on a worksheet (Named:
Category). I have named the table: =Category!$A$2:$A$51

Once all the data fields have been filled by the user, then maybe the
subroutine shown below could be used to create the new lines at the
bottom of the worksheet and populate the data that was entered by the
user.

Example: the user has just filled in the following fields:

Finance File No: FTAN00459
Full Name: KEVIN BROWN
FY: 08-09
Date of Request: 27-FEB-09
Category: TRAINING
WBS Element No: DSPT0019S
Cost Centre Code: 100206
How Many New Lines: 6


The last empty row in the worksheet (Named: register) is cell A13.

The userform and VBA code creates 6 new lines using the sub-routine
below.

So range A13: G18 will have the data filled in so it looks like this:

(Cell: A13) FTAN00459, (Cell: B13) KEVIN BROWN, (Cell: C13) 08-09,
(Cell: D13) 27-FEB-09, (Cell: E13) TRAINING, (Cell: F13) DSPT00195,
(Cell: G13) 100206
(Cell: A14) FTAN00459, (Cell: B14) KEVIN BROWN, (Cell: C14) 08-09,
(Cell: D14) 27-FEB-09, (Cell: E14) TRAINING, (Cell: F14) DSPT00195,
(Cell: G14) 100206
(Cell: A15) FTAN00459, (Cell: B15) KEVIN BROWN, (Cell: C15) 08-09,
(Cell: D15) 27-FEB-09, (Cell: E15) TRAINING, (Cell: F15) DSPT00195,
(Cell: G15) 100206
(Cell: A16) FTAN00459, (Cell: B16) KEVIN BROWN, (Cell: C16) 08-09,
(Cell: D16) 27-FEB-09, (Cell: E16) TRAINING, (Cell: F16) DSPT00195,
(Cell: G16) 100206
(Cell: A17) FTAN00459, (Cell: B17) KEVIN BROWN, (Cell: C17) 08-09,
(Cell: D17) 27-FEB-09, (Cell: E17) TRAINING, (Cell: F17) DSPT00195,
(Cell: G17) 100206
(Cell: A18) FTAN00459, (Cell: B18) KEVIN BROWN, (Cell: C18) 08-09,
(Cell: D18) 27-FEB-09, (Cell: E18) TRAINING, (Cell: F18) DSPT00195,
(Cell: G18) 100206

Lastly, cell: H13 needs to be selected so the user can start entering
more data.

Any help on this would be very much appreciated.

Kind regards,

Chris.



Sub New_Line()

Range("A2").Select

Application.ScreenUpdating = False

'I think that the last cell should be named here
'and not at the end of the sub.

With Sheets("Register")
'Following line of code is like selecting the last cell
'in the column and holding the Ctrl key and press Up arrow
'It then names the cell.
.Cells(.Rows.Count, "A").End(xlUp).Name = "LastCell"

'Following line finds last cell in column M and
'copies that cell formula to the row below.
.Cells(.Rows.Count, "I").End(xlUp).Copy _
Destination:=.Cells(.Rows.Count, "I") _
.End(xlUp).Offset(1, 0)
End With

Range("LastCell").Select

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Rows("1:1").EntireRow.Select

Selection.RowHeight = 25.5

ActiveCell.Range("A1:T1").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With

Sheets("Register").Select



Range("LastCell").Offset(1, 0).Select


End Sub





*** Sent via Developersdex http://www.developersdex.com ***
 
B

Bernie Deitrick

Assuming that you have 7 TextBoxes and 1 listbox on your userform, with one commandbutton, use this
code for the userform: Textbox7 should be the one with the number entered:

Private Sub UserForm_Initialize()
Me.ListBox1.List = Range("Category").Value
End Sub


Private Sub CommandButton1_Click()
Dim i As Integer
Dim myR As Long

myR = Worksheets("Register").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To CInt(Me.TextBox7.Text)
Worksheets("Register").Cells(myR + i, 1).Value = Me.TextBox1.Text
Worksheets("Register").Cells(myR + i, 2).Value = Me.TextBox2.Text
Worksheets("Register").Cells(myR + i, 3).Value = Me.TextBox3.Text
Worksheets("Register").Cells(myR + i, 4).Value = Me.TextBox4.Text
Worksheets("Register").Cells(myR + i, 5).Value = Me.ListBox1.Text
Worksheets("Register").Cells(myR + i, 6).Value = Me.TextBox5.Text
Worksheets("Register").Cells(myR + i, 7).Value = Me.TextBox6.Text
Next i
Worksheets("Register").Cells(myR + 1, 8).Select
Unload Me

End Sub


HTH,
Bernie
MS Excel MVP
 
C

Chris

Hi Bernie, thanks very much for your help - greatly appreciated.
However, I have a couple of things that need tidying up:

I created the UserForm2. TextBox6 is used to tell Excel how many new
lines of data is required. This works well. However, if for example I
enter into TextBox6 the number 4, then after clicking on the
CommandButton, the VBA code you provided creates 4 new line entries at
the bottom of my worksheet. The number 4 however, is also showing up
4-times in column G.

I modified your code slightly due to me being a newbie to VBA. The
modified code only changes the TextBox numbers to match up with those on
UserForm2.

Below is the modified code:

Could you please advise on how the VBA code that you provided will run
my subroutine the same number of times as the number entered in to
TextBox7?

Also, could you please advise on how I can change the <TAB> order for
UserForm2. At the moment, it <TABs> from TextBox1 to TextBox2 to
TextBox3 to TextBox4 to ListBox1 to CommandButton1 to TextBox7.

Kind regards,

Chris.

Private Sub UserForm_Initialize()
On Error Resume Next
Me.ListBox1.List = Range("Category").Value
End Sub
Private Sub CommandButton1_Click()
Dim i As Integer
Dim myR As Long

On Error Resume Next

myR = Worksheets("Register").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To CInt(Me.TextBox7.Text)
Worksheets("Register").Cells(myR + i, 1).Value = Me.TextBox1.Text
Worksheets("Register").Cells(myR + i, 2).Value = Me.TextBox2.Text
Worksheets("Register").Cells(myR + i, 3).Value = Me.TextBox3.Text
Worksheets("Register").Cells(myR + i, 4).Value = Me.TextBox4.Text
Worksheets("Register").Cells(myR + i, 5).Value = Me.ListBox1.Text
Worksheets("Register").Cells(myR + i, 6).Value = Me.TextBox6.Text
Worksheets("Register").Cells(myR + i, 7).Value = Me.TextBox7.Text
Next i
Worksheets("Register").Cells(myR + 1, 8).Select
Unload Me

End Sub

My subroutine:

Sub New_Line()

Range("A2").Select

Application.ScreenUpdating = False

'I think that the last cell should be named here
'and not at the end of the sub.

With Sheets("Register")
'Following line of code is like selecting the last cell
'in the column and holding the Ctrl key and press Up arrow
'It then names the cell.
.Cells(.Rows.Count, "A").End(xlUp).Name = "LastCell"

'Following line finds last cell in column M and
'copies that cell formula to the row below.
.Cells(.Rows.Count, "J").End(xlUp).Copy _
Destination:=.Cells(.Rows.Count, "J") _
.End(xlUp).Offset(1, 0)
End With

With Sheets("Register")
'Following line of code is like selecting the last cell
'in the column and holding the Ctrl key and press Up arrow
'It then names the cell.
.Cells(.Rows.Count, "A").End(xlUp).Name = "LastCell"

'Following line finds last cell in column M and
'copies that cell formula to the row below.
.Cells(.Rows.Count, "H").End(xlUp).Copy _
Destination:=.Cells(.Rows.Count, "H") _
.End(xlUp).Offset(1, 0)
End With

Range("LastCell").Select

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Rows("1:1").EntireRow.Select

Selection.RowHeight = 25.5

ActiveCell.Range("A1:U1").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With

Sheets("Register").Select



Range("LastCell").Offset(1, 0).Select


End Sub


*** Sent via Developersdex http://www.developersdex.com ***
 
C

Chris

Hi Bernie, here is the modified code:

Private Sub CommandButton1_Click()
Dim i As Integer
Dim myR As Long

On Error Resume Next

myR = Worksheets("Register").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To CInt(Me.TextBox7.Text)
Worksheets("Register").Cells(myR + i, 1).Value = Me.TextBox1.Text
Worksheets("Register").Cells(myR + i, 2).Value = Me.TextBox2.Text
Worksheets("Register").Cells(myR + i, 3).Value = Me.TextBox3.Text
Worksheets("Register").Cells(myR + i, 4).Value = Me.TextBox4.Text
Worksheets("Register").Cells(myR + i, 5).Value = Me.ListBox1.Text
Worksheets("Register").Cells(myR + i, 6).Value = Me.ListBox2.Text
Next i
Worksheets("Register").Cells(myR + 1, 8).Select
Unload Me

End Sub

I have successfully fixed the Tab Order of UserForm2 and also fixed the
repeating numbers in column G.

All I need to do now is incorporate my subroutine to repeat itself as
many times as the number entered in TextBox7.

Could you please help me with that?

Cheers,

Chris.



*** Sent via Developersdex http://www.developersdex.com ***
 
C

Chris

Hi Bernie, A stroke of good luck - I played around with the code and
got it all to work beautifully. So, thanks - I guess I will not need
your kind assistance.

Cheers,

Chris.



*** Sent via Developersdex http://www.developersdex.com ***
 
B

Bernie Deitrick

Chris,

I'm happy to hear that you got it all to work - and that you learned
something, too.

Bernie
 

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

help needed with borders 2
Border formatting row of cells 22
Formatting stop when reach blank cell 6
Looping Help Please 5
Loops through Sheets but doesn't work. 5
Hlp! Adv Filter - Non-Contiguous rows don't copy 11
Vlookup help please 2
Recorded macro fails after save, close, then reopen 8

Top