Export from Excel to Access via VBA based on cell Value

N

NewPadawan

New Member
Joined
Dec 1, 2021
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Hello All,

I'm currently using Office 16 on Windows platform, and am looking to export data from an Excel sheet in one of my workbooks to MS Access. I've got the basic outline down, and am able to send data from Excel to Access, however, I am looking to only send rows based on a cell value. In column W lies to variables: "Done", "Not Done". I would like to export the row data ONLY if column W contains "Done". Would anyone be able to point me in the right direction on how/where to include that parameter? I've attached a sample workbook and will post the code below:

VBA Code: 
Sub TransfertoAccess()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long

' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ace.oledb.12.0; " & _
"Data Source= C:\Users\Jennifer\Documents\InventoryControl.accdb"

' open a recordset
Set rs = New ADODB.Recordset
rs.Open "CycleCountResearchTEST", cn, adOpenKeyset, adLockOptimistic, adCmdTable

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

' repeat until first empty cell in column A
With rs

.AddNew ' create a new record
' add values to each field in the record
.Fields("Count ID") = Range("A" & r).Value
.Fields("Aisle") = Range("B" & r).Value
.Fields("Bay") = Range("C" & r).Value
.Fields("Level") = Range("D" & r).Value
.Fields("Case ID") = Range("E" & r).Value
.Fields("PartCode") = Range("F" & r).Value
.Fields("Description") = Range("G" & r).Value
.Fields("Asset Code") = Range("H" & r).Value
.Fields("Case Good?") = Range("I" & r).Value
.Fields("Sealed?") = Range("J" & r).Value
.Fields("Counter Notes") = Range("K" & r).Value
.Fields("System QTY") = Range("L" & r).Value
.Fields("Counted QTY") = Range("M" & r).Value
.Fields("Value") = Range("N" & r).Value
.Fields("Cycle Counter") = Range("O" & r).Value
.Fields("Over/Short") = Range("P" & r).Value
.Fields("QTY Adjusted") = Range("Q" & r).Value
.Fields("Extended Value") = Range("R" & r).Value
.Fields("Date of Last Transaction") = Range("S" & r).Value
.Fields("Root Cause") = Range("T" & r).Value
.Fields("Researcher Notes") = Range("U" & r).Value
.Fields("Fixed?") = Range("V" & r).Value
.Fields("Done?") = Range("W" & r).Value
.Fields("Researcher") = Range("X" & r).Value
.Fields("Error User ID") = Range("Y" & r).Value
.Fields("Date and Time Counted") = Range("Z" & r).Value
.Fields("Research File Name") = Range("AA" & 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
cn.Close
Set cn = Nothing

End Sub

CycleCountResearch1 - Copy.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAA
1
2Name:
3Count IDLocationCasePartDescriptionAsset CodeCase Good?Sealed?Counter Notes?Qty in SysCounted QtyValueO/SQty Adjusted Extended Value Date of Last TransactionRoot CauseNotesFixed?Done?NameUser ID if ErrorDate And Time Counted
51.1012E+1162175FVZC04486365SLS-BR0497EAEXAWS + PCS DUAL BAND RU (4T4R, 320W)NIL5$ 7,975.00 SHEEM Short5$ (39,875.00)1/31/2021Unpick transaction errorSending to MS AccessYesDone 12/1/2021 9:0011/2/2021 6:57CycleCountResearch1 - Copy.xlsm
61.1012E+1162189AVZC04694776SLS-BR0497EAEXAWS + PCS DUAL BAND RU (4T4R, 320W)MatchYSYS 5, +358$ 7,975.00 SHEEM Over32$ 255,200.002/14/2021Picked Wrong Qty (Too many/Too few)Sending to MS AccessYesDone 12/1/2021 9:0011/2/2021 7:02CycleCountResearch1 - Copy.xlsm
71.1012E+1165157AVZC04541721KRK10101/11SM6701 28GHZ AC HWEA2A158127NIL1$ 6,092.19 christian Short15$ (91,382.85)11/25/2021Picked from Wrong LocationSending to MS AccessYesDone 12/1/2021 9:0011/2/2021 7:01CycleCountResearch1 - Copy.xlsm
81.1012E+1166204AVZC04392020NW-LSRUCV-02VZBRACKET ASSEMBLY-700+850MHZ RU COVERNILN20$ 107.00 ANDREW Short4$ (428.00)12/1/2021Placed in OS&D In ErrorSending to MS AccessYesDone 12/1/2021 9:0011/2/2021 10:51CycleCountResearch1 - Copy.xlsm
91.1012E+1166198AVZC04097634NW-LSRUFI-02VZ700+850MHZ/PCS+AWS RU BRACKET ASSEMBLY-POLE MOUNTINGMatchNSYS 121216$ 100.00 ANDREW Over$ -Testing the longrange fieldNot Done 11/2/2021 10:47CycleCountResearch1 - Copy.xlsm
101.1012E+1166200AVZC04099455NW-LSRUFI-02VZ700+850MHZ/PCS+AWS RU BRACKET ASSEMBLY-POLE MOUNTINGMatchNSYS 363626$ 100.00 ANDREW Short$ -Testing the longrange fieldNot Done 11/2/2021 10:51CycleCountResearch1 - Copy.xlsm
111.1012E+1166204AVZC04392020NW-LSRUCV-02VZBRACKET ASSEMBLY-700+850MHZ RU COVERNILN20$ 107.00 ANDREW Short$ -Testing the longrange fieldNot Done 11/2/2021 10:51CycleCountResearch1 - Copy.xlsm
121.1022E+1155087BVZC04321924NW-LSRUPC-02VZCABLE ASSEMBLY-DC POWER, (15M)NILN10$ 261.00 ANDREW Short$ -Not Done 11/2/2021 11:13CycleCountResearch1 - Copy.xlsm
131.1022E+1155087BVZC04321924SLS-BB1150EHEXCPRI OPTIC MODULE (20KM,9.8GBPS, DUPLEX)NILN20$ 114.00 ANDREW Short$ -Not Done 11/2/2021 11:13CycleCountResearch1 - Copy.xlsm
141.1022E+1155087BVZC04321925SLS-BB1150EHEXCPRI OPTIC MODULE (20KM,9.8GBPS, DUPLEX)NILN20$ 114.00 ANDREW Short$ -Not Done 11/2/2021 11:15CycleCountResearch1 - Copy.xlsm
151.1022E+1155087BVZC04321926NW-LSRUCV-02VZBRACKET ASSEMBLY-700+850MHZ RU COVERNILN10$ 107.00 ANDREW Short$ -Not Done 11/2/2021 11:16CycleCountResearch1 - Copy.xlsm
161.1022E+1155087BVZC04321926SLS-BB1150EHEXCPRI OPTIC MODULE (20KM,9.8GBPS, DUPLEX)NILN20$ 114.00 ANDREW Short$ -Not Done 11/2/2021 11:16CycleCountResearch1 - Copy.xlsm
171.1022E+1155090CNW-LSRUCP-01VZCABLE ASSEMBLY-OPTIC SINGLE OUTDOOR CABLE (10M)NILN170$ 60.00 ANDREW Short$ -Not Done 11/2/2021 11:27CycleCountResearch1 - Copy.xlsm
181.1022E+1155092EVZC04055409SLS-BR0497EAEXAWS + PCS DUAL BAND RU (4T4R, 320W)MatchNSYS 552$ 7,975.00 ANDREW Short$ -Not Done 11/2/2021 11:27CycleCountResearch1 - Copy.xlsm
191.1022E+1155096AVZC04472002NW-FSPOLEH35VZMOUNTING BRACKET (POLE MOUNT, 35-60KG MMU)NILN30$ 370.00 ANDREW Short$ -Not Done 11/2/2021 11:31CycleCountResearch1 - Copy.xlsm
201.1022E+1155097AVZC04479127NW-LSRUFI-02VZ700+850MHZ/PCS+AWS RU BRACKET ASSEMBLY-POLE MOUNTINGNILN190$ 100.00 ANDREW Short$ -Not Done 11/2/2021 11:32CycleCountResearch1 - Copy.xlsm
211.1022E+1155103FVZC03798066SLS-BR0497EAEXAWS + PCS DUAL BAND RU (4T4R, 320W)MatchNSYS 552$ 7,975.00 ANDREW Short$ -Not Done 11/2/2021 11:35CycleCountResearch1 - Copy.xlsm
221.1022E+1155106AVZC01595850109142980QS873A THERMAL PROBENILN20$ 10.00 ANDREW Short$ -Not Done 11/2/2021 11:42CycleCountResearch1 - Copy.xlsm
231.1022E+1155106AVZC015958501500491951800A/-48V NEM/ 52 POSITION CB/26 SELECT/6 URS/7FT RACKNILN10$ 5,100.00 ANDREW Short$ -Not Done 11/2/2021 11:42CycleCountResearch1 - Copy.xlsm
241.1022E+1155106AVZC01595850407998277CIRCUIT BREAKER, 100A, 150VDC, 600VACNILN80$ 24.00 ANDREW Short$ -Not Done 11/2/2021 11:42CycleCountResearch1 - Copy.xlsm
CycleCountResearch
Cell Formulas
RangeFormula
W5:W24W5=IF(P5="Good","Done",IF(ISBLANK(T5),"Not Done",IF(ISBLANK(Q5),"Not Done",IF(ISBLANK(S5),"Not Done",IF(V5="Yes","Done","Not Done")))))
X5:X24X5=IF((ISBLANK(CycleCountResearch!$K$2)),"",CycleCountResearch!$K$2)
R5:R24R5=IFERROR((IF(P5="Good",0,IF(P5="Short",(Q5*N5*-1),(Q5*N5*1)))),"")
AA5:AA24AA5=MID(CELL("filename"),SEARCH("[",CELL("filename"))+1, SEARCH("]",CELL("filename"))-SEARCH("[",CELL("filename"))-1)
Cells with Conditional Formatting
CellConditionCell FormatStop If True
R:RCell Valuebetween 1000 and 99999999textNO
R:RCell Valuebetween -9999999999 and -1000textNO
Cells with Data Validation
CellAllowCriteria
H3:J3Any value
V3Any value
P3Any value
Q3:R4Any value
H5:H24Whole numberbetween 0 and 99999999
S:SDatebetween 1/1/2019 and 1/1/2055
T:TList='Root Cause Tree'!$B$4:$B$26
V5:V24List=DropDowns!$E$1:$E$3
P5:P1048576List=DropDowns!$A$1:$A$3
Q5:R1048576Whole numberbetween -99999 and 999999
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
VBA Compile error - Trying to send an email using VBA/Excel
Replies
6
Views
538
gorgkhan
G
J
  • Question
Naming Worksheets based on column values.
Replies
1
Views
588
Alex Blakenburg
A
L
  • Question
Insert a number of rows based on a cell value and insert a new string in said rows.
Replies
1
Views
663
Joe4
Joe4
M
  • Solved
Excel Userform: certain fields need to be entered
Replies
6
Views
471
Micron
M
1
  • Question
Inserting new rows based on cell value and copying data to the new rows
Replies
0
Views
760
10digwa
1

Forum statistics

Threads
1,215,049
Messages
6,122,864
Members
449,097
Latest member
dbomb1414

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top