Code:
Sub Submit_Request()
Dim objForm As Worksheet, objRequests As Worksheet
Dim targetrow As Range
Dim DAOdBase As DAO.Database
Dim DAORecSet As DAO.Recordset
Dim xRow As Long, xCol As Integer
Dim xDelete As String, exrange As Range
Dim i As Long
Set objForm = Sheets("Enter")
If Trim(objForm.Cells(7, "D").Value) = "" Then
objForm.Cells(7, "D").Select
MsgBox "Please enter the Card number"
Exit Sub
End If
If Trim(objForm.Cells(5, "H").Value) = "" Then
objForm.Cells(5, "H").Select
MsgBox "Please enter Client"
Exit Sub
End If
If Trim(objForm.Cells(7, "H").Value) = "" Then
objForm.Cells(7, "H").Select
MsgBox "Please enter User"
Exit Sub
End If
If Trim(objForm.Cells(9, "D").Value) = "" Then
objForm.Cells(9, "D").Select
MsgBox "Please enter Option 1"
Exit Sub
End If
If Trim(objForm.Cells(11, "D").Value) = "" Then
objForm.Cells(11, "D").Select
MsgBox "Please enter Requested by"
Exit Sub
End If
If Trim(objForm.Cells(13, "D").Value) = "" Then
objForm.Cells(13, "D").Select
MsgBox "Please enter some comments"
Exit Sub
End If
If Trim(objForm.Cells(5, "L").Value) = "" Then
objForm.Cells(5, "L").Select
MsgBox "Please enter status"
Exit Sub
ElseIf UCase(Trim(objForm.Cells(5, "L").Value)) = "RESOLVED" Then
' determine target sheet
Set objRequests = Sheets("Resolved")
Else
Set objRequests = Sheets("Pending")
End If
On Error Resume Next
Application.EnableEvents = False
Set targetrow = objRequests.Cells(objRequests.Cells(6000, "A").End(xlUp).Row + 1, "A")
With targetrow
.Offset(0, 0).Value = objForm.Cells(22, "D").Value
.Offset(0, 1).Value = objForm.Cells(5, "D").Value
.Offset(0, 2).Value = objForm.Cells(7, "D").Value
.Offset(0, 3).Value = objForm.Cells(5, "H").Value
.Offset(0, 4).Value = objForm.Cells(7, "H").Value
.Offset(0, 5).Value = objForm.Cells(9, "D").Value
.Offset(0, 6).Value = objForm.Cells(9, "H").Value
.Offset(0, 7).Value = objForm.Cells(11, "D").Value
.Offset(0, 8).Value = objForm.Cells(11, "H").Value
.Offset(0, 9).Value = objForm.Cells(13, "D").Value
.Offset(0, 11).Value = objForm.Cells(5, "L").Value
End With
i = objRequests.Cells(65536, "a").End(xlUp).Row
Set k = objRequests.Range("A" & i & ":N" & i)
ActiveWorkbook.Names.Add Name:="Raw1", RefersTo:=k
Application.EnableEvents = True
xpath = "Your Path where database is saved\db1.mdb"
Set DAOdBase = DBEngine.OpenDatabase(xpath)
xrange = "Raw1"
Set exrange = Range(xrange)
xtable = "btable"
Set DAORecSet = DAOdBase.OpenRecordset(xtable)
For xRow = 1 To exrange.Rows.Count
DAORecSet.AddNew
For xCol = 1 To exrange.Columns.Count
DAORecSet.Fields(xCol) = exrange.Cells(xRow, xCol).Value
Next xCol
DAORecSet.Update
Next xRow
MsgBox "Your Complaint Ref is " & objForm.Cells(22, "D")
' Now clear the form
objForm.Cells(7, "D").Value = ""
objForm.Cells(9, "D").Value = ""
objForm.Cells(5, "H").Value = ""
objForm.Cells(7, "H").Value = ""
objForm.Cells(9, "H").Value = ""
objForm.Cells(11, "D").Value = ""
objForm.Cells(19, "E").Value = ""
objForm.Cells(11, "H").Value = ""
objForm.Cells(13, "D").Value = ""
objForm.Cells(5, "L").Value = ""
End Sub
Bookmarks