PDA

View Full Version : Solved: Data won't copy to database



coliervile
06-28-2006, 06:58 AM
I can't get the data from the userform to copy to the database (OvertimeDatabse) worksheet. :banghead: :dunno

I can't figure out the VBA ?????

Would greatly appreciate you help!

Charlie

compariniaa
06-28-2006, 08:17 AM
I had problems with your workbook...I got errors just running the userform. But I saw enough to tell you this:
You need to populate your comboboxes. The easiest way to do this is to edit the code for the entire userform. when you click "view code" for the userform, you'll see something like this
Sub userform_click()

End sub.

change "click" to "initialize", then add the following lines:

With cboName
.additem "AA"
.additem "BB"
'etc...add all the names you need
End With
With cboName2
.additem "AB"
'and so on
End With Then, edit the code for your OK button (I don't remember if you had one). But with your OK button, the code should look something like this:
Sub OK_click()
Dim FirstBlank as Integer
FirstBlank=Range("A65536").End(xlUp).Row+1
Sheets("Overtime Database").Range("A"&FirstBlank).value=cboName.value
'it doesn't have to be in range A1, put it wherever you want.
'use the same method for all your objects on your userform, putting them wherever you want
'and redefine FirstBlank by changing the columns that
'correspond to where you want everything to go
Unload UserForm1
End Sub
good luck!

coliervile
06-28-2006, 10:33 AM
Thanks for your input and I'll try it out.

mdmackillop
06-28-2006, 02:56 PM
You need to go through both sets of data one after the other. You code is reading then overwriting values before they are handled. I've added some basic looping, a bit cludgy, but you'll see the idea. I amended the code slightly to accept only one name on the form.
Regards
MD


Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lName As Long
Dim ws As Worksheet
Dim Cnt As Long
Set ws = Worksheets("OvertimeDatabase")
'Loop through form twice
Cnt = 0
Do
'find first empty row in database
lRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
Cnt = Cnt + 1
If Cnt = 1 Then lName = Me.cboName.ListIndex
If Cnt = 2 Then lName = Me.cboName2.ListIndex

'check for employee name
If Cnt = 1 Then
If Trim(Me.cboName.Value) = "" Then
Me.cboName.SetFocus
MsgBox "Please enter a employee name"
Exit Sub
End If
End If
If Cnt = 2 Then
If Trim(Me.cboName2.Value) = "" Then
GoTo ClearData
End If
End If
'copy the data to the database
If Cnt = 1 Then
With ws
.Cells(lRow, 1) = Me.cboName.Value
.Cells(lRow, 2) = Me.txtDate.Value
.Cells(lRow, 3) = Me.txtHours.Value
.Cells(lRow, 4) = Me.cboOffer.Value
End With
End If
If Cnt = 2 Then
With ws
.Cells(lRow, 1) = Me.cboName2.Value
.Cells(lRow, 2) = Me.txtDate2.Value
.Cells(lRow, 3) = Me.txtHours2.Value
.Cells(lRow, 4) = Me.cboOffer2.Value
End With
End If
Loop Until Cnt = 2
ClearData:
'clear the data
Me.cboName.Value = ""
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtHours.Value = ""
Me.cboOffer.Value = ""
Me.cboName2.Value = ""
Me.txtDate2.Value = Format(Date, "Medium Date")
Me.txtHours2.Value = ""
Me.cboOffer2.Value = ""
Me.cboName.SetFocus

End Sub

coliervile
06-28-2006, 03:38 PM
Thanks for your idea MDMACKILLOP haven't had a chance to try either idea but I'll let you two know the out come. Thanks a million.

Regards- Charlie

coliervile
06-28-2006, 07:57 PM
"mdmackillop" your code worked great. Question- if I want to add more namers is it as easy as-


'find first empty row in database
lRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
Cnt = Cnt + 1

'check for employee name
If Cnt = 1 Then
If Trim(Me.cboName.Value) = "" Then
Me.cboName.SetFocus
MsgBox "Please enter a employee name"
Exit Sub
End If
End If
If Cnt = 2 Then
If Trim(Me.cboName2.Value) = "" Then
Goto ClearData
End If
End If
'copy the data to the database
If Cnt = 1 Then
With ws
.Cells(lRow, 1) = Me.cboName.Value
.Cells(lRow, 2) = Me.txtDate.Value
.Cells(lRow, 3) = Me.txtHours.Value
.Cells(lRow, 4) = Me.cboOffer.Value
End With
End If
If Cnt = 2 Then
With ws
.Cells(lRow, 1) = Me.cboName2.Value
.Cells(lRow, 2) = Me.txtDate2.Value
.Cells(lRow, 3) = Me.txtHours2.Value
.Cells(lRow, 4) = Me.cboOffer2.Value
End With
End If
If Cnt = 3 Then
With ws
.Cells(lRow, 1) = Me.cboName3.Value
.Cells(lRow, 2) = Me.txtDate3.Value
.Cells(lRow, 3) = Me.txtHours3.Value
.Cells(lRow, 4) = Me.cboOffer3.Value
End With
End If
Loop Until Cnt = 3

Best Regards
Charlie

mdmackillop
06-29-2006, 12:44 AM
Hi Charlie,
I've edited your code to correct minor errors, but not tested it.
Regards
MD

coliervile
06-29-2006, 05:05 PM
The other thing that I would like to do is have the "OvertimeDatabse" worksheet to automatically update and sort column "A"-"NAMES" when the data is added from clicking the "Add Overtime" button on the "Overtime Form" userform.

mdmackillop
06-29-2006, 11:52 PM
Try recording a macro to carry out the action you specify, then call that macro by adding its name at the end of cmdAdd_Click macro. Once you see that this is working, you should attempt to tidy this up using a With statement for the worksheet, sorting the range references and getting rid of "Selection" etc.

coliervile
06-30-2006, 04:14 AM
I'm completely new at VBA and a true rookie. Would the Macro you refer to be written to do the "sorting"? I've viewed a number of other sorting VBA's on here and I'm not quite sure what I need to write? Your assistance would be helpful. I would imagine that if I wanted the OvertimeDatabase to update I could write a macro for the cmdAdd_Click to update the associated Pivot Table to the database?????

I did add a few other employees name to your other code and it worked perfect.

Have a great weekend.

Best Regards....

Charlie

mdmackillop
06-30-2006, 05:37 AM
Hi Charlie,
To record a macro, starting from your "button" page,
Tools/Macros/Record new macro/Stor in /This Workbook.
Select the sheet to be sorted
Select the columns to be sorted
Do the Sort
Return to the original page
Stop recording
Look at your code and add its name to your button code.

coliervile
06-30-2006, 06:48 AM
I'll give it whirl...thanks

Best Regards

Charlie

coliervile
06-30-2006, 05:25 PM
I've tied a number of thing and couldn't figure the coding out. I put a code it the OvetimeEntry worksheet:

Private Sub cmdAdd_Click()
Dim rngSort As Range

Set rngSort = ActiveSheet("OvertimeDatabase").Range("A2:H6854")

rngSort.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set rngSort = Nothing
End Sub

I can't get it to run, my guess is the ActiveWorksheet line is not correct???????????:banghead: :motz2: :bug: :think:

Help is requested

mdmackillop
06-30-2006, 11:23 PM
Hi Charlie,
No need really to figure out coding. Recording a macro should give you

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 01/07/2006 by Charlie'
'
Sheets("OvertimeDatabase").Select
Columns("A:D").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range("A1").Select
Sheets("OvertimeEntry").Select
End Sub

This can be tidied up to give


Sub Macro2()
' Macro revised by MD
With Sheets("OvertimeDatabase").Columns("A:D")
.Sort Key1:=.Range("A2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With

End Sub




and get's incorporated into your codes as


Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lName As Long
Dim ws As Worksheet
Dim Cnt As Long

Set ws = Worksheets("OvertimeDatabase")
'Loop through form twice
Cnt = 0
Do
'find first empty row in database
lRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
Cnt = Cnt + 1
If Cnt = 1 Then lName = Me.cboName.ListIndex
If Cnt = 2 Then lName = Me.cboName2.ListIndex

'check for employee name
If Cnt = 1 Then
If Trim(Me.cboName.Value) = "" Then
Me.cboName.SetFocus
MsgBox "Please enter a employee name"
Exit Sub
End If
End If
If Cnt = 2 Then
If Trim(Me.cboName2.Value) = "" Then
GoTo ClearData
End If
End If
'copy the data to the database
If Cnt = 1 Then
With ws
.Cells(lRow, 1) = Me.cboName.Value
.Cells(lRow, 2) = Me.txtDate.Value
.Cells(lRow, 3) = Me.txtHours.Value
.Cells(lRow, 4) = Me.cboOffer.Value
End With
End If

If Cnt = 2 Then
With ws
.Cells(lRow, 1).Value = Me.cboName2.Value
.Cells(lRow, 2).Value = Me.txtDate2.Value
.Cells(lRow, 3).Value = Me.txtHours2.Value
.Cells(lRow, 4).Value = Me.cboOffer2.Value
End With
End If
Loop Until Cnt = 2

ClearData:
'clear the data
Me.cboName.Value = ""
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtHours.Value = ""
Me.cboOffer.Value = ""
Me.cboName2.Value = ""
Me.txtDate2.Value = Format(Date, "Medium Date")
Me.txtHours2.Value = ""
Me.cboOffer2.Value = ""
Me.cboName.SetFocus
'Add sorting macro
Macro2

End Sub

coliervile
07-01-2006, 12:13 AM
Good Morning. I've tried running both Macros and I get the same error message: Compile error-Expected End Sub

I believe I have everything correct- see attached file

Have a great day

mdmackillop
07-01-2006, 12:49 AM
It's not neccesary to copy the code into your your code, just the name of the macro exactly as shown, although to avoid duplication problems, let's change the names.

Your code should end

'Add sorting macro
SortMyData
End Sub

and the following sub added to your workbook

Sub SortMyData()
With Sheets("OvertimeDatabase").Columns("A:D")
.Sort Key1:=.Range("A2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
End Sub

mdmackillop
07-01-2006, 12:58 AM
The advantage of keeping small macros in separate routines is that they can be passed variables to process from different procedures EG

Sub Sort1
'Sorts A-D on A & B
SortMyData "A: D", "A2", "B2"
End Sub

Sub Sort2
'Sorts R-Z on S & Q
SortMyData "R:Z", "S2", "Q2"
End Sub

' and so on

Sub SortMyData(Data As String, S1 As String, S2 As String)
With Sheets("OvertimeDatabase").Columns(Data)
.Sort Key1:=.Range(S1), Order1:=xlAscending, _
Key2:=.Range(S2), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
End Sub

coliervile
07-01-2006, 01:12 AM
Thanks, it worked great. I'm a true rookie, but catching on slowly. Can a similar sort work for my pivot table or does it require something different?

mdmackillop
07-01-2006, 01:23 AM
Glad its working.
Sorry, never use pivot tables. I suggest you post a new question for that part. If this is concluded, please mark it solved using Thread Tools.

coliervile
07-01-2006, 01:32 AM
mdmackillop I thank you for all of you assistance. I will close this item out. Have a great day.

Best regards,

Charlie