How to automatically populate an Excel database w/data from many forms?

  • Thread starter Thread starter kevi007
  • Start date Start date
K

kevi007

I have a data collection spreadsheet laid out like a form for multipl
users; each user will do a save as to create hundreds of records o
copies of this form. We are using the data collected to build an Exce
database. Currently we are manually keying the data from the form
into a single spreadsheet (the database). Is there a way to automat
the transfer of the data from the forms into the database? Also, eac
record will have a unique ID number. We are working in MS Excel 2002.
Thank you
 
I think I'd tell the user to run a macro that would copy the cells from their
worksheet into the database workbook when they were happy with their data entry.

Option Explicit
Sub testme01()

Application.ScreenUpdating = False

Dim toWks As Worksheet
Dim formWks As Worksheet
Dim NextRow As Long
Dim iCtr As Long
Dim beforeAddress As Variant
Dim afterCol As Variant
Dim DBWkbkName As String
Dim DBWksName As String

Set formWks = ActiveSheet

DBWkbkName = "c:\my documents\excel\database.xls"
DBWksName = "sheet1"

Set toWks = Nothing
On Error Resume Next
Set toWks = Workbooks.Open(Filename:=DBWkbkName).Worksheets(DBWksName)
On Error GoTo 0

If toWks Is Nothing Then
MsgBox "The database workbook is currently unavailable." & _
vbNewLine & _
"Please don't forget to try later--phone #### for help."
Application.ScreenUpdating = True
Exit Sub
End If

beforeAddress = Array("C6", "C7", "C8", "d9", "f10", "g11", "h12", "j13")
afterCol = Array("c", "d", "e", "f", "g", "h", "i", "j")

If UBound(afterCol) <> UBound(beforeAddress) Then
MsgBox "Error in before layout!"
Application.ScreenUpdating = True
Exit Sub
End If

With toWks
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1

With .Cells(NextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With

.Cells(NextRow, "B").Value = Application.UserName

For iCtr = LBound(beforeAddress) To UBound(beforeAddress)
'move 'em in
.Cells(NextRow, afterCol(iCtr)).Value _
= formWks.Range(beforeAddress(iCtr)).Value
'wipe out existing values???
'formWks.Range(beforeAddress(iCtr)).ClearContents
Next iCtr
.Parent.Close savechanges:=True
MsgBox "Saved to: " & DBWkbkName & " worksheet: " & DBWksName
End With

Application.ScreenUpdating = True

End Sub
 
This is quite a big question. There are all kinds of variation
possible. To get you started, this macro finds the next blank row i
your database and copies data from the form.

1. copy this macro into a code module in your form template and put
button in your form to run it from the Forms toolbar. (Right clic
button/Assign Macro)
2. Change the file names and cell references for Currentform.

'------------------------------------------
Sub TRANSFER_DATA_FROM_FORM()
'- have a form active and run this macro
Dim CurrentForm As Worksheet
Dim Datafile As Worksheet
Dim NewRecordRow As Long
'------------------------
Set CurrentForm = ActiveSheet
Set Datafile = Workbooks("DataBase.xls").Worksheets("Data")
'- find next blank row in the database
'- this example uses column A
NewRecordRow = Datafile.Range("A65536").End(xlUp).Row + 1
'- transfer data from form
Datafile.Cells(NewRecordRow, 1).Value
CurrentForm.Range("A1").Value
Datafile.Cells(NewRecordRow, 2).Value
CurrentForm.Range("B1").Value
End Sub
'-------------------------------------------
 
Thank you, this sounds like a great idea and I will definately try it.
Thanks again!!! :) ~~Laura
 
Back
Top