Transfer Data from Different Cells and Copy to Other Sheet

[manona]

Hi!

I've built a basic form (not using the form function, just plain cells) in Excel, which users will input data. There are about 25 random individual cells for data entry, such as Name, School, Date, etc. In another sheet, I have built the frame for a small Database (e.g. A2 is "Name", B2 is "School", C2 is "Date", and so on).

I would like to add a button at the bottom of the form, so that once they have completed the data entry, data from the specific input cells are transferred to the Database under their respective areas.

A few requirements:
1) It needs to be a copy & paste VALUE.
2) The data will be kept there, so every time that button is pressed, the new data needs to be copied to the next available blank row.
3) FYI: I have a button that once they have completed the transfer, they click on it and it clears all of their input data.
4) If this is not too much to ask, is there a way to add a message box after the transfer is done, that says "Data was successfully transferred"?

Thanks a million in advance

 

[Trebor76]

Hi manona,

To get you started, the following will put (as values) the data from one cell (A10) to another (B5) across two tabs:

Option Explicit
Sub Macro1()

    Dim wsRawData As Worksheet
    Dim wsDb As Worksheet
    Dim lngPasteRow As Long
    
    Application.ScreenUpdating = False
    
    'Sheet name where the raw data (form) resides. Change to suit if necessary.
    Set wsRawData = ThisWorkbook.Sheets("Sheet1")
    
    'Sheet name where the raw data is to be stored (copied to). Change to suit if necessary.
    Set wsDb = ThisWorkbook.Sheets("Sheet2")
    
    'Surpress error message if there's no data on the 'wsDb' sheet.
    'Finds the last row on the 'wsDb' sheet
    On Error Resume Next
        lngPasteRow = wsDb.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If lngPasteRow = 0 Then
            lngPasteRow = 2 'Default row number if there's no data on the the 'wsDb' sheet. Change to suit if necessary.
        Else
            'If there was no error assigning the value to the 'lngPasteRow' variable, increment that value by 1.
            lngPasteRow = lngPasteRow + 1
        End If
    On Error GoTo 0
    
    'Data transfer from 'wsRawData' sheet to 'wsDb' sheet
    '--The following will populate cell B5 on the 'wsDb' tab with the contents of
    'cell A10 from the 'wsRawData' sheet (as values) as an initial example.
    'Link all the required cells this way--
    
    wsDb.Range("B5").Value = wsRawData.Range("A10")
    
    Set wsRawData = Nothing
    Set wsDb = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Data was successfully transferred", vbInformation

End Sub

I've also included notes to help explain what the code is doing and where you'd have make changes to customize it to your specific needs.

HTH

Robert

 

[manona]

Hi Robert,

This worked perfectly, thank you so much for the instructions and for the quick reply!

Manon A

 

[Trebor76]

Thanks for the feedback and you're welcome

 

[manona]

Hey Robert!

I actually tried filling in the form a second time with new/different data, and it just did an override in the database of the previous data entry.

I did a copy/paste of your code and only modified where you mentioned. In the part:

If lngPasteRow = 0 Then
lngPasteRow = 2
I changed 2 for 10, as that is the first row to insert data. The rest I did not touch (except the specific cells to be copied and to be pasted).

The second form I tried also copied in row 10, instead of row 11 like it should.

Any thoughts on why it didn't work?

Thanks again and sorry for the back and forth!

Manon

 

[Trebor76]

No, if there's data on Row 10 of the wsDb tab the next line should be 11

Try stepping through the code (by pressing F8 while in the code) to pinpoint what the issue may be.

 

[Trebor76]

Ah my bad - change this line...

wsDb.Range("B5").Value = wsRawData.Range("A10")

...to this:

wsDb.Range("B" & lngPasteRow).Value = wsRawData.Range("A10")

You will need to do this for each cell you want linked.

Robert

 

[AndyMachin]

What about this code?

Sub StoreInDB()
'Those variables will be treated as string, including the date (this can be changed if you want)
Dim Name, School, vDate
'this variable is to find the last row with data in the DB sheet
Dim LastRow As Integer

'Here you retreive the data in the form (I don't know in what cells they are, but make the changes)
Name = Sheets("Sheet1").Range("A1").Value
School = Sheets("Sheet1").Range("A2").Value
vDate = Sheets("Sheet1").Range("A3").Value

Application.ScreenUpdating = False
'Assing the LastRow variable, but do a quick check for first time user
LastRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
If Sheets("Sheet2").Range("A10").Value = "" Then
    Sheets("Sheet2").Range("A10").Value = Name
    Sheets("Sheet2").Range("B10").Value = School
    Sheets("Sheet2").Range("C10").Value = vDate
Else
    Sheets("Sheet2").Range("A" & LastRow).Value = Name
    Sheets("Sheet2").Range("B" & LastRow).Value = School
    Sheets("Sheet2").Range("C" & LastRow).Value = vDate
End If

'Your message
MsgBox "Data was successfully transferred", vbInformation, "Continue..."

'you can clear the form right here so no need to click two different buttons
'but just ignore and delete the following code if you want.
Sheets("Sheet1").Range("A1,A2,A3").ClearContents 'add all cells or ranges you want

Application.ScreenUpdating = True
End Sub

 

[manona]

Hi Robert,

I've applied the changes (wsDb.Range("B" & lngPasteRow).Value = wsRawData.Range("A10")), but now no data goes to the Database when I press the button.

Could it have to do with this part of the code now?

On Error Resume Next
lngPasteRow = wsDb.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If lngPasteRow = 0 Then
lngPasteRow = 10
Else
lngPasteRow = lngPasteRow + 1
End If
On Error GoTo 0

Thanks for your help!

 

[AndyMachin]

Hi Robert,

I've applied the changes (wsDb.Range("B" & lngPasteRow).Value = wsRawData.Range("A10")), but now no data goes to the Database when I press the button.

Could it have to do with this part of the code now?

On Error Resume Next
lngPasteRow = wsDb.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If lngPasteRow = 0 Then
lngPasteRow = 10
Else
lngPasteRow = lngPasteRow + 1
End If
On Error GoTo 0

Thanks for your help!

Hello manona, give a try to my code. If you do so, make sure you read the comment lines
I can also include an error handling and a required field check if you want