Private Sub CommandButton1_Click()

'Sub BNGCTS()
' exports data from the active worksheet to a table in an Acces
database
' this procedure must be edited before use

Dim db As Database, rs As Recordset, r As Long, sh As Worksheet

Set db
OpenDatabase("\\blrdsbgl401\blr_lcd_qmt$\QMT\Buffe r\db1.mdb")
' open the database

'For Each sh In ThisWorkbook.Worksheets


Set rs = db.OpenRecordset("BNG-CTS", dbOpenTable)

' get all records in a table
r = 3 ' the start row in the worksheet

Do While Len(Range("A" & r).Formula) 0

' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Created Date") = Range("A" & r).Value
.Fields("Title") = Range("B" & r).Value
.Fields("Evaluator") = Range("C" & r).Value
.Fields("Member Code") = Range("D" & r).Value
.Fields("Agent") = Range("E" & r).Value
.Fields("TM") = Range("F" & r).Value
.Fields("AM") = Range("G" & r).Value
.Fields("Combo Compliance email") = Range("H" & r).Value
.Fields("CE Combo HeatCheck") = Range("I" & r).Value
.Fields("CE Combo Esurvey") = Range("J" & r).Value
.Fields("Issue Recognition (Empathy/Accountability)")
Range("K" & r).Value
.Fields("reviewed historical information") = Range("L"
r).Value
.Fields("effectively used DSN prior to dispatching parts"
= Range("M" & r).Value
.Fields("issue within support boundaries") = Range("N"
r).Value
.Fields("followed support boundary policy & procedures")
Range("O" & r).Value
.Fields("Con_TS_R1_Within_Boundaries_R") = Range("P"
r).Value
.Fields("Con_TS_R1_Boundaries_PnP_R") = Range("Q"
r).Value
.Fields("Con_TS_R1_Position_HlpDsk_R") = Range("R"
r).Value
.Fields("positioned Help Desk appropriately per CT
guidelines") = Range("S" & r).Value
.Fields("handle the customers request for an escalatio
appropriately") = Range("T" & r).Value
.Fields("Resolution Communication") = Range("U" & r).Value
.Fields("Provided resolution") = Range("V" & r).Value
.Fields("proactive measures to avoid customer callbacks")
Range("W" & r).Value
.Fields("On escalated issues") = Range("X" & r).Value
.Fields("followed support boundary policy & procedures2")
Range("Y" & r).Value
.Fields("Con_TS_R2_Boundaries_PnP_R") = Range("Z"
r).Value
.Fields("effectively used DSN prior to dispatching parts2"
= Range("AA" & r).Value
.Fields("handle the customers request for an escalatio
appropriately2") = Range("AB" & r).Value
.Fields("Issue Recognition (Empathy/Accountability)2")
Range("AC" & r).Value
.Fields("positioned Help Desk appropriately per CT
guidelines2") = Range("AD" & r).Value
.Fields("Con_TS_R2_Position_HlpDsk_R") = Range("AE"
r).Value
.Fields("Provided resolution2") = Range("AF" & r).Value
.Fields("Resolution Communication2") = Range("AG"
r).Value
.Fields("On escalated issues2") = Range("AH" & r).Value
.Fields("reviewed historical information2") = Range("AI"
r).Value
.Fields("issue within support boundaries2") = Range("AJ"
r).Value
.Fields("Con_TS_R2_Within_Boundaries_R") = Range("AK"
r).Value
.Fields("followed support boundary policy & procedures3")
Range("AL" & r).Value
.Fields("Con_TS_R3_Boundaries_PnP_R") = Range("AM"
r).Value
.Fields("effectively used DSN prior to dispatching parts3"
= Range("AN" & r).Value
.Fields("handle the customers request for an escalatio
appropriately3") = Range("AO" & r).Value
.Fields("Issue Recognition (Empathy/Accountability)3")
Range("AP" & r).Value
.Fields("positioned Help Desk appropriately per CT
guidelines3") = Range("AQ" & r).Value
.Fields("Con_TS_R3_Position_HlpDsk_R") = Range("AR"
r).Value
.Fields("Provided resolution3") = Range("AS" & r).Value
.Fields("Resolution Communication3") = Range("AT"
r).Value
.Fields("On escalated issues3") = Range("AU" & r).Value
.Fields("reviewed historical information3") = Range("AV"
r).Value
.Fields("issue within support boundaries3") = Range("AW"
r).Value
.Fields("Con_TS_R3_Within_Boundaries_R") = Range("AX"
r).Value
.Fields("Rep properly open the call") = Range("AY"
r).Value
.Fields("ask for and update the customers email address")
Range("AZ" & r).Value
.Fields("follow appropriate dispatch procedures") =
Range("BA" & r).Value
.Fields("follow the Case Ownership process (when
appropriate)") = Range("BB" & r).Value
.Fields("fulfilled committed callback") = Range("BC" &
r).Value
.Fields("rep properly close the call") = Range("BD" &
r).Value
.Fields("log the call completely and accurately") =
Range("BE" & r).Value
.Fields("Con_TS_B_Logging_R") = Range("BF" & r).Value
.Fields("Con_TS_B_Email_R") = Range("BG" & r).Value
.Fields("call accurately profiled") = Range("BH" &
r).Value
.Fields("technician transfer appropriately") = Range("BI" &
r).Value
.Fields("Rate of Speech") = Range("BJ" & r).Value
.Fields("Sentence Structure/Grammar") = Range("BK" &
r).Value
.Fields("Word Choice/Jargon") = Range("BL" & r).Value
.Fields("Active Listening") = Range("BM" & r).Value
.Fields("Hold & Dead Air") = Range("BN" & r).Value
.Fields("Call Control (Flow)") = Range("BO" & r).Value
.Fields("Professionalism") = Range("BP" & r).Value
.Fields("appropriately addresses terms and conditions of
sale") = Range("BQ" & r).Value
.Fields("address Export Compliance issues completely and
accurately") = Range("BR" & r).Value
.Fields("protects customer account privacy policy") =
Range("BS" & r).Value
.Fields("Customer verification completed") = Range("BT" &
r).Value
.Fields("Con_TS_P_T&C_R") = Range("BU" & r).Value
.Fields("Con_TS_P_Export_Compl_R") = Range("BV" & r).Value
.Fields("Con_TS_P_Privacy_Policy_R") = Range("BW" &
r).Value
.Fields("Con_TS_P_Cust_Verification_R") = Range("BX" &
r).Value
.Fields("CE Policy requirements") = Range("BY" & r).Value
.Fields("Qscore") = Range("BZ" & r).Value
.Fields("Segment") = Range("CA" & r).Value

' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub


--
bhellsun
------------------------------------------------------------------------
bhellsun's Profile: http://www.excelforum.com/member.php...o&userid=26798
View this thread: http://www.excelforum.com/showthread...hreadid=400424