Option Explicit
Sub trsfr()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("entryform")
Set s2 = Sheets("database")
Dim lr As Long
lr = s2.Range("B" & Rows.Count).End(xlUp).Row
With s1
.Range("C2").Copy s2.Range("B" & lr + 1)
.Range("A6").Copy s2.Range("D" & lr + 1)
'continue to copy and paste using this example for the rest of your cells
.Range("C2").ClearContents
.Range("A6").ClearContents
'continue to clear contents for the remaining cells
End With
End Sub
Sub Transfer_data()
Dim lastRow As Long, WsEntry As Worksheet, WsDb As Worksheet
Dim Cus_Found As Range
Set WsEntry = Sheets("entryform")
Set WsDb = Sheets("database")
Set Cus_Found = WsDb.Range("B:B").Find(WsEntry.Range("customerID").Value) ' to check customer id already entered in database sheet
With Application
.ScreenUpdating = False
End With
If IsEmpty(WsEntry.Range("customerID").Value) Then
MsgBox "Please enter Customer ID.", vbCritical, "Customer Entry Form"
Exit Sub
End If
If Cus_Found Is Nothing Then
lastRow = WsDb.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row
WsDb.Range("B" & lastRow).Value = WsEntry.Range("customerID").Value
WsDb.Range("D" & lastRow).Value = WsEntry.Range("FirstName").Value
WsDb.Range("F" & lastRow).Value = WsEntry.Range("LastName").Value
WsDb.Range("H" & lastRow).Value = WsEntry.Range("Mobile_No").Value
WsDb.Range("J" & lastRow).Value = WsEntry.Range("Work_No").Value
WsDb.Range("L" & lastRow).Value = WsEntry.Range("Email").Value
WsDb.Range("N" & lastRow).Value = WsEntry.Range("Street_Address").Value
WsDb.Range("P" & lastRow).Value = WsEntry.Range("City").Value
WsDb.Range("R" & lastRow).Value = WsEntry.Range("State").Value
WsDb.Range("T" & lastRow).Value = WsEntry.Range("Zip_Code").Value
MsgBox "Customer ID successfully updated in database.", , "Customer Entry Form"
Else
MsgBox "Customer ID already captured.", , "Customer Entry Form"
End If
' clear the form for next entry
WsEntry.Range("customerID").ClearContents
WsEntry.Range("FirstName").ClearContents
WsEntry.Range("LastName").ClearContents
WsEntry.Range("Mobile_No").ClearContents
WsEntry.Range("Work_No").ClearContents
WsEntry.Range("Email").ClearContents
WsEntry.Range("Street_Address").ClearContents
WsEntry.Range("City").ClearContents
WsEntry.Range("State").ClearContents
WsEntry.Range("Zip_Code").ClearContents
With Application
.ScreenUpdating = True
End With
End Sub
Hi,
I hope you wanted to keep updating the data to database for every entry in entryform.
Here you go ..
Code:Sub Transfer_data() Dim lastRow As Long, WsEntry As Worksheet, WsDb As Worksheet Dim Cus_Found As Range Set WsEntry = Sheets("entryform") Set WsDb = Sheets("database") Set Cus_Found = WsDb.Range("B:B").Find(WsEntry.Range("customerID").Value) ' to check customer id already entered in database sheet With Application .ScreenUpdating = False End With If IsEmpty(WsEntry.Range("customerID").Value) Then MsgBox "Please enter Customer ID.", vbCritical, "Customer Entry Form" Exit Sub End If If Cus_Found Is Nothing Then lastRow = WsDb.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row WsDb.Range("B" & lastRow).Value = WsEntry.Range("customerID").Value WsDb.Range("D" & lastRow).Value = WsEntry.Range("FirstName").Value WsDb.Range("F" & lastRow).Value = WsEntry.Range("LastName").Value WsDb.Range("H" & lastRow).Value = WsEntry.Range("Mobile_No").Value WsDb.Range("J" & lastRow).Value = WsEntry.Range("Work_No").Value WsDb.Range("L" & lastRow).Value = WsEntry.Range("Email").Value WsDb.Range("N" & lastRow).Value = WsEntry.Range("Street_Address").Value WsDb.Range("P" & lastRow).Value = WsEntry.Range("City").Value WsDb.Range("R" & lastRow).Value = WsEntry.Range("State").Value WsDb.Range("T" & lastRow).Value = WsEntry.Range("Zip_Code").Value MsgBox "Customer ID successfully updated in database.", , "Customer Entry Form" Else MsgBox "Customer ID already captured.", , "Customer Entry Form" End If ' clear the form for next entry WsEntry.Range("customerID").ClearContents WsEntry.Range("FirstName").ClearContents WsEntry.Range("LastName").ClearContents WsEntry.Range("Mobile_No").ClearContents WsEntry.Range("Work_No").ClearContents WsEntry.Range("Email").ClearContents WsEntry.Range("Street_Address").ClearContents WsEntry.Range("City").ClearContents WsEntry.Range("State").ClearContents WsEntry.Range("Zip_Code").ClearContents With Application .ScreenUpdating = True End With End Sub
Here you go ..
Code:Sub Transfer_data() Dim lastRow As Long, WsEntry As Worksheet, WsDb As Worksheet Dim Cus_Found As Range Set WsEntry = Sheets("entryform") Set WsDb = Sheets("database") Set Cus_Found = WsDb.Range("B:B").Find(WsEntry.Range("customerID").Value) ' to check customer id already entered in database sheet With Application .ScreenUpdating = False End With If IsEmpty(WsEntry.Range("customerID").Value) Then MsgBox "Please enter Customer ID.", vbCritical, "Customer Entry Form" Exit Sub End If If Cus_Found Is Nothing Then lastRow = WsDb.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row WsDb.Range("B" & lastRow).Value = WsEntry.Range("customerID").Value WsDb.Range("D" & lastRow).Value = WsEntry.Range("FirstName").Value WsDb.Range("F" & lastRow).Value = WsEntry.Range("LastName").Value WsDb.Range("H" & lastRow).Value = WsEntry.Range("Mobile_No").Value WsDb.Range("J" & lastRow).Value = WsEntry.Range("Work_No").Value WsDb.Range("L" & lastRow).Value = WsEntry.Range("Email").Value WsDb.Range("N" & lastRow).Value = WsEntry.Range("Street_Address").Value WsDb.Range("P" & lastRow).Value = WsEntry.Range("City").Value WsDb.Range("R" & lastRow).Value = WsEntry.Range("State").Value WsDb.Range("T" & lastRow).Value = WsEntry.Range("Zip_Code").Value MsgBox "Customer ID successfully updated in database.", , "Customer Entry Form" Else MsgBox "Customer ID already captured.", , "Customer Entry Form" End If ' clear the form for next entry WsEntry.Range("customerID").ClearContents WsEntry.Range("FirstName").ClearContents WsEntry.Range("LastName").ClearContents WsEntry.Range("Mobile_No").ClearContents WsEntry.Range("Work_No").ClearContents WsEntry.Range("Email").ClearContents WsEntry.Range("Street_Address").ClearContents WsEntry.Range("City").ClearContents WsEntry.Range("State").ClearContents WsEntry.Range("Zip_Code").ClearContents With Application .ScreenUpdating = True End With End Sub
Here you go ..
Code:Sub Transfer_data() Dim lastRow As Long, WsEntry As Worksheet, WsDb As Worksheet Dim Cus_Found As Range Set WsEntry = Sheets("entryform") Set WsDb = Sheets("database") Set Cus_Found = WsDb.Range("B:B").Find(WsEntry.Range("customerID").Value) ' to check customer id already entered in database sheet With Application .ScreenUpdating = False End With If IsEmpty(WsEntry.Range("customerID").Value) Then MsgBox "Please enter Customer ID.", vbCritical, "Customer Entry Form" Exit Sub End If If Cus_Found Is Nothing Then lastRow = WsDb.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row WsDb.Range("B" & lastRow).Value = WsEntry.Range("customerID").Value WsDb.Range("D" & lastRow).Value = WsEntry.Range("FirstName").Value WsDb.Range("F" & lastRow).Value = WsEntry.Range("LastName").Value WsDb.Range("H" & lastRow).Value = WsEntry.Range("Mobile_No").Value WsDb.Range("J" & lastRow).Value = WsEntry.Range("Work_No").Value WsDb.Range("L" & lastRow).Value = WsEntry.Range("Email").Value WsDb.Range("N" & lastRow).Value = WsEntry.Range("Street_Address").Value WsDb.Range("P" & lastRow).Value = WsEntry.Range("City").Value WsDb.Range("R" & lastRow).Value = WsEntry.Range("State").Value WsDb.Range("T" & lastRow).Value = WsEntry.Range("Zip_Code").Value MsgBox "Customer ID successfully updated in database.", , "Customer Entry Form" Else MsgBox "Customer ID already captured.", , "Customer Entry Form" End If ' clear the form for next entry WsEntry.Range("customerID").ClearContents WsEntry.Range("FirstName").ClearContents WsEntry.Range("LastName").ClearContents WsEntry.Range("Mobile_No").ClearContents WsEntry.Range("Work_No").ClearContents WsEntry.Range("Email").ClearContents WsEntry.Range("Street_Address").ClearContents WsEntry.Range("City").ClearContents WsEntry.Range("State").ClearContents WsEntry.Range("Zip_Code").ClearContents With Application .ScreenUpdating = True End With End Sub
Try this
Second version.
I forgot to code the search.