MS Access record delete from excel database query results

I figured out that it is a four step process...

Step #1

Sub DisplayObjectHistory()
'Display the records for a certain object item
Dim InputA As String
InputA = InputBox("Enter ObjectId")
MsgBox ("You entered: " & InputA)
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=C:\Dbase\dBase.mde;DriverId=25;FIL=MS Access;MaxBuffe" _
), Array("rSize=2048;PageTimeout=5;")), Destination:=Range("A1"))
.CommandText = Array( _
"SELECT * FROM History History WHERE (History.ObjectID like'" & InputA & "%') ORDER BY History.DateEntered")
.Name = "QGetting Object Info..."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub


Step #2
Copy this info to sheet 2 (you can easily write a macro to do this)

Step #3
Delete all records from the same ObjectID with this

Sub ADO_Delete()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long, InputA As String
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\dBase\dBase.mde;"
On Error Resume Next
Set rs = New ADODB.Recordset
InputA = InputBox("Enter ObjectID to Delete All records from")
MsgBox ("You entered: " & InputA)
rs.Open "Delete * From History ObjectID Where (History.ObjectID='" & InputA & "')", cn
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Step #4
Enter Edited Records from copied Worksheet

Sub Update_dBase()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=c:\dBase\dBase.mde;"
On Error Resume Next
Set rs = New ADODB.Recordset
rs.Open "History", cn, adOpenKeyset, adLockOptimistic, adCmdTable
r = 2 ' row to start update records where info starts
Do While Len(Range("A" & r).Formula) > 0
With rs
.AddNew
.Fields("Object") = Range("A" & r).Value
.Fields("Object_Status_History") = Range("B" & r).Value
.Update
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Maybe I can automate all of this into one macro??????

Chachi WROX
I was able to figure this out with a lot of beer and internet searches..
LOL