VBA question convert form(s) into a database

cyrilbrd

cyrilbrd

Well-known Member
Joined
Feb 2, 2012
Messages
4,113
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
Good day,
Given an excel form filled up by users, said form contains several fields and data.
I would like to convert these into a database by copying the data to the next empty row.
Example of the form:
Book1.xlsm
ABCDEFG
1Form filled up and printed by user
2
3desig11
4desig22
5desig33
6desig44
7
8tbl1field1field2field3field4
9Type15678
10Type29101112
11Type313141516
12Type417181920
13Type521222324
14
15tbl2field5field6field7field8field9field10
16Type6252627282930
17Type7313233343536
18Type8373839404142
19
20tbl3field11
21Type943
22Type1044
23Type1145
form


And this is how the database would look like, with each subsequent iteration of the form copied to the next empty row, thus allowing extraction of data from the created DB via formulae or pivot...
Book1.xlsm
ABCDEFGHIJKLMNOP
28desig1desig2desig3desig4TypeField1Field2Field3Field4Field5Field6Field7Field8Field9Field10Field11
291234Type15678
301234Type29101112
311234Type313141516
321234Type417181920
331234Type521222324
341234Type6252627282930
351234Type7313233343536
361234Type8373839404142
371234Type943
381234Type1044
391234Type1145
form

Any suggestion would be welcome.
The idea would be for the file to have only two (2) tabs, on for the form, and one for the DB, the user would encode the form and 'copy' it to the DB via vba.
Thanks.
 
Last edited:

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Sort by date Sort by votes
cyrilbrd said:
Example of the form:
Click to expand...
Your first XL2BB only example one user.
Where is the following user form data ? The cell "A24:G46" ?

The same in the second XL2BB.
In the DB sheet, is the following data in the cells "A40:P50" ?

The VBA you need is not hard to write.
But you should explain all the data structure clearly.
 
Upvote 0
HongRu said:
Your first XL2BB only example one user.
Where is the following user form data ? The cell "A24:G46" ?
Click to expand...
Only one user form would be required.
Upon completion of encoding said form, the data would be copied (submitted) to the DB and the form would be cleared, readied for another set of data.



HongRu said:
The same in the second XL2BB.
In the DB sheet, is the following data in the cells "A40:P50" ?
Click to expand...
Yes If the fields are complete, it would copy the next set starting row 40 and so on.
 
Upvote 0
try this.
HTH.
VBA Code: 
Sub sbDB_Copy()
    Dim Ws1 As Worksheet
    Set Ws1 = Worksheets("DB") 'Worksheet name is "DB" Or whatever you need
    
    Dim R1 As Range
    Set R1 = Ws1.Range("A28") 'Or whatever you need
    R1 = "desig1" 'the first title
    
    Dim Ws2 As Worksheet
    Set Ws2 = Worksheets("form") 'Worksheet name is "form" Or whatever you need
    
    Set R1 = R1.End(xlDown).End(xlDown).End(xlUp).Offset(1, 0)
    
    R1.Resize(11, 4) = WorksheetFunction.Transpose(Ws2.Range("B3:B6"))
    R1.Offset(0, 4).Resize(5, 1) = Ws2.Range("A9:A13").Value
    R1.Offset(5, 4).Resize(3, 1) = Ws2.Range("A16:A18").Value
    R1.Offset(8, 4).Resize(3, 1) = Ws2.Range("A21:A23").Value
    
    R1.Offset(0, 5).Resize(5, 4) = Ws2.Range("C9:F13").Value
    
    R1.Offset(5, 9).Resize(3, 6) = Ws2.Range("B16:G18").Value
    
    R1.Offset(8, 15).Resize(3, 1) = Ws2.Range("B21:B23").Value
End Sub
 
Upvote 0
Thanks for the guidelines, I modified to fit the model and adjusted accordingly.
In the instance that a user might not finish encoding data or skip some fields.
Would it be possible to 'recall' the information, add whatever is lacking and repost in the DB tab?
What would be your opinion here?
 
Upvote 0
It is possible.

To recall, the data should have a key value, ex: the cell B3 of desig1, and the key must be identified only for one unique user.

Then, we can have a code to find if the key exist in the DB before running the copy paste macro.
If the key exist, we find the existing key cell in DB, and copy the update data on the existing cells belonging to the same user by the copy paste macro.
If the key doesn't exist, we just use the copy paste macro on the bottom new blank row in DB sheet.

HTH
 
Upvote 0
Desig1 is indeed a unique identifier and would indeed be the trigger to recall data.
 
Upvote 0
Try.
The code below will find the value of "Desig1 " of the "form" sheet in the column A of "DB" sheet.
If the user's data already exist, the code will find the existing cells belong to the user and copy new data to paste on the old.
If not exist, it will add new data from the last blank cell.
VBA Code: 
Sub sbDB_Copy()
    Dim Ws1 As Worksheet
    Set Ws1 = Worksheets("DB") 'Worksheet name is "DB" Or whatever you need
    
    Dim R1 As Range
    Set R1 = Ws1.Range("A28") 'Or whatever you need
    R1 = "desig1" 'the first title
    
    Dim Ws2 As Worksheet
    Set Ws2 = Worksheets("form") 'Worksheet name is "form" Or whatever you need
    
    'find if user's data exists or not
    Dim myFind As Range
    Set myFind = Ws1.Range("A:A").Find(What:=Ws2.Range("B3"), After:=Ws1.Range("A1"), LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False)
    
    If myFind Is Nothing Then
        Set R1 = R1.End(xlDown).End(xlDown).End(xlUp).Offset(1, 0)
    Else
        Set R1 = myFind
    End If
    
    R1.Resize(11, 4) = WorksheetFunction.Transpose(Ws2.Range("B3:B6"))
    R1.Offset(0, 4).Resize(5, 1) = Ws2.Range("A9:A13").Value
    R1.Offset(5, 4).Resize(3, 1) = Ws2.Range("A16:A18").Value
    R1.Offset(8, 4).Resize(3, 1) = Ws2.Range("A21:A23").Value
    
    R1.Offset(0, 5).Resize(5, 4) = Ws2.Range("C9:F13").Value
    
    R1.Offset(5, 9).Resize(3, 6) = Ws2.Range("B16:G18").Value
    
    R1.Offset(8, 15).Resize(3, 1) = Ws2.Range("B21:B23").Value
End Sub

The following code is to recall data from the "DB" sheet according to the value of "Desig1 " of the "form" sheet.
To Recall means to copy the old data of "DB" to paste in the cells of the "form" sheet.
VBA Code: 
Sub sbRecall()
    Dim Ws1 As Worksheet
    Set Ws1 = Worksheets("DB") 'Worksheet name is "DB" Or whatever you need
    
    Dim R1 As Range
    Set R1 = Ws1.Range("A28") 'Or whatever you need
    R1 = "desig1" 'the first title
    
    Dim Ws2 As Worksheet
    Set Ws2 = Worksheets("form") 'Worksheet name is "form" Or whatever you need
    
    'find if user's data exists or not
    Dim myFind As Range
    Set myFind = Ws1.Range("A:A").Find(What:=Ws2.Range("B3"), After:=Ws1.Range("A1"), LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False)
    
    If myFind Is Nothing Then
        MsgBox "The user's data do not exist."
    Else
        Set R1 = myFind
        
        Ws2.Range("B3:B6") = WorksheetFunction.Transpose(R1.Resize(11, 4))
        Ws2.Range("A9:A13") = R1.Offset(0, 4).Resize(5, 1).Value
        Ws2.Range("A16:A18") = R1.Offset(5, 4).Resize(3, 1).Value
        Ws2.Range("A21:A23") = R1.Offset(8, 4).Resize(3, 1).Value
        
        Ws2.Range("C9:F13") = R1.Offset(0, 5).Resize(5, 4).Value
        
        Ws2.Range("B16:G18") = R1.Offset(5, 9).Resize(3, 6).Value
        
        Ws2.Range("B21:B23") = R1.Offset(8, 15).Resize(3, 1).Value
        MsgBox "The user's data have recalled."
    End If
End Sub
 
Upvote 0
HongRu said:
Try.
The code below will find the value of "Desig1 " of the "form" sheet in the column A of "DB" sheet.
If the user's data already exist, the code will find the existing cells belong to the user and copy new data to paste on the old.
If not exist, it will add new data from the last blank cell.
VBA Code: 
Sub sbDB_Copy()
    Dim Ws1 As Worksheet
    Set Ws1 = Worksheets("DB") 'Worksheet name is "DB" Or whatever you need
   
    Dim R1 As Range
    Set R1 = Ws1.Range("A28") 'Or whatever you need
    R1 = "desig1" 'the first title
   
    Dim Ws2 As Worksheet
    Set Ws2 = Worksheets("form") 'Worksheet name is "form" Or whatever you need
   
    'find if user's data exists or not
    Dim myFind As Range
    Set myFind = Ws1.Range("A:A").Find(What:=Ws2.Range("B3"), After:=Ws1.Range("A1"), LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False)
   
    If myFind Is Nothing Then
        Set R1 = R1.End(xlDown).End(xlDown).End(xlUp).Offset(1, 0)
    Else
        Set R1 = myFind
    End If
   
    R1.Resize(11, 4) = WorksheetFunction.Transpose(Ws2.Range("B3:B6"))
    R1.Offset(0, 4).Resize(5, 1) = Ws2.Range("A9:A13").Value
    R1.Offset(5, 4).Resize(3, 1) = Ws2.Range("A16:A18").Value
    R1.Offset(8, 4).Resize(3, 1) = Ws2.Range("A21:A23").Value
   
    R1.Offset(0, 5).Resize(5, 4) = Ws2.Range("C9:F13").Value
   
    R1.Offset(5, 9).Resize(3, 6) = Ws2.Range("B16:G18").Value
   
    R1.Offset(8, 15).Resize(3, 1) = Ws2.Range("B21:B23").Value
End Sub

The following code is to recall data from the "DB" sheet according to the value of "Desig1 " of the "form" sheet.
To Recall means to copy the old data of "DB" to paste in the cells of the "form" sheet.
VBA Code: 
Sub sbRecall()
    Dim Ws1 As Worksheet
    Set Ws1 = Worksheets("DB") 'Worksheet name is "DB" Or whatever you need
   
    Dim R1 As Range
    Set R1 = Ws1.Range("A28") 'Or whatever you need
    R1 = "desig1" 'the first title
   
    Dim Ws2 As Worksheet
    Set Ws2 = Worksheets("form") 'Worksheet name is "form" Or whatever you need
   
    'find if user's data exists or not
    Dim myFind As Range
    Set myFind = Ws1.Range("A:A").Find(What:=Ws2.Range("B3"), After:=Ws1.Range("A1"), LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False)
   
    If myFind Is Nothing Then
        MsgBox "The user's data do not exist."
    Else
        Set R1 = myFind
       
        Ws2.Range("B3:B6") = WorksheetFunction.Transpose(R1.Resize(11, 4))
        Ws2.Range("A9:A13") = R1.Offset(0, 4).Resize(5, 1).Value
        Ws2.Range("A16:A18") = R1.Offset(5, 4).Resize(3, 1).Value
        Ws2.Range("A21:A23") = R1.Offset(8, 4).Resize(3, 1).Value
       
        Ws2.Range("C9:F13") = R1.Offset(0, 5).Resize(5, 4).Value
       
        Ws2.Range("B16:G18") = R1.Offset(5, 9).Resize(3, 6).Value
       
        Ws2.Range("B21:B23") = R1.Offset(8, 15).Resize(3, 1).Value
        MsgBox "The user's data have recalled."
    End If
End Sub
Click to expand...
This is to acknowledge receipt.
Will adjust to fit model and will get back to you.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Question
Data Update using VBA
Replies
0
Views
156
yogeshCR7
Y
G
  • Question
Bug with passing variables between user forms--VBA
Replies
4
Views
121
Domenic
D
R
  • Question
User form textbox to determine specific worksheet location for input data
Replies
1
Views
283
Skyybot
Skyybot
S
  • Question
Macro: flatten sheet, delete other tab, and save
Replies
4
Views
222
steallan
S
A
  • Question
Recording Excel ranges from several tabs into Access DB
Replies
1
Views
363
alansidman
A

Forum statistics

Threads
1,215,261
Messages
6,123,948
Members
449,134
Latest member
NickWBA

Share this page

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