PDA

View Full Version : Solved: Excel to access cell for cell import



White_Nova
11-07-2007, 03:09 AM
Hi All

Please would you be so kind as to tell me where im going wrong?

I have a form in excel that writes to an excel sheet, in the VBA(Below), i have requested the cells update a access database.

however i get an error when trying to run it (Try it...)

Sub Paymentinput()
' exports data from the active worksheet to a table in an Access database

Dim db As Database
Dim rs As Recordset

Set db = OpenDatabase(ActiveWorkbook.Path & "\DataStore.mdb")

' open the database

Set rs = db.OpenRecordset("1", dbOpenTable)
' get all records in a table

Sheets("Database").Select

With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("ID") = range("A2").Value
.Fields("Manager") = range("B2").Value
.Fields("Date") = range("C2").Value
.Fields("Session") = range("D2").Value
.Fields("Lead Number") = range("E2").Value
.Fields("Surname") = range("F2").Value
.Fields("Consultant") = range("G2").Value
.Fields("Prize") = range("H2").Value
.Fields("Chosen Number") = range("I2").Value
.Fields("Actual Number") = range("J2").Value
.Fields("Start Time") = range("K2").Value
.Fields("End Time") = range("L2").Value
.Fields("Difference") = range("M2").Value



' add more fields if necessary...
.update 'stores the new record
End With


rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

range("A2").Select
ActiveCell.FormulaR1C1 = ""
range("B2").Select
ActiveCell.FormulaR1C1 = ""
range("C2").Select
ActiveCell.FormulaR1C1 = ""
range("D2").Select
ActiveCell.FormulaR1C1 = ""
range("E2").Select
ActiveCell.FormulaR1C1 = ""
range("F2").Select
ActiveCell.FormulaR1C1 = ""
range("G2").Select
ActiveCell.FormulaR1C1 = ""
range("H2").Select
ActiveCell.FormulaR1C1 = ""
range("I2").Select
ActiveCell.FormulaR1C1 = ""
range("J2").Select
ActiveCell.FormulaR1C1 = ""
range("K2").Select
ActiveCell.FormulaR1C1 = ""
range("L2").Select
ActiveCell.FormulaR1C1 = ""
range("M2").Select
ActiveCell.FormulaR1C1 = ""


range("A2").Select

End Sub


Please see if you can help....!!!!

Many thanks:bow:

White_Nova
11-07-2007, 03:20 AM
Just some extra info, bot the Excel and Access docs are in the same folder, i have a feeling it has something to do with the References in VBA but have tried all of them...

Charlize
11-07-2007, 03:33 AM
Sub AddData()
'Original coding from XLD
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\DataStore.mdb"
'Store is the name of your datatable in DataStore.mdb
'If table has different name, use that name
'And I'm not sure about the format the data must have.
'Maybe they have to be all in string format ?
sSQL = "INSERT INTO Store (ID, Manager,Date, Session) " & _
"VALUES ('" & [A2] & "','" & [B2] & "','" & [C2] & "','" & [D2] & "')"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing
Range("A2:M2").ClearContents
End Sub

White_Nova
11-07-2007, 03:38 AM
Hi Charlize

Many thanks, i do however get an error on this line...
oConn.Execute sSQL

Charlize
11-07-2007, 03:40 AM
Hi Charlize

Many thanks, i do however get an error on this line...
oConn.Execute sSQLDescribe the error.

White_Nova
11-07-2007, 04:20 AM
Run-Time Error '-2147217900 (80040e14):'

Syntax Error in INSERT INTO Statement.

Charlize
11-07-2007, 04:37 AM
I believe it's got something to do with your Date as fieldname (maybe even ID and Session). It seems to me that they are close to reserved keywords. When I renamed them to MyId, MyDate and MySession the adding took place.

White_Nova
11-07-2007, 04:53 AM
That seems to working 100% Charlize thanks, 1 thing though, the form in excel does not work... but its a data manager for Excel, can you help?

White_Nova
11-07-2007, 05:38 AM
h

White_Nova
11-07-2007, 05:39 AM
Hi Charlize

The full line of data is not pulling through to Access.
i have ammended the code provided a little, please tell me where im going wrong?

Sub PaymentInput()
'Original coding from XLD
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\DataStore.mdb"
sSQL = "INSERT INTO Store (MYID, TIMEIN, MYDATE, MYSESSION, MANAGER, LEADNUMBER, CONSULTANT, PRIZE, ACTUALNUMBER, CHOSENNUMBER, TIMEOUT, DIFFERENCE) " & _
"VALUES ('" & [A2] & "','" & [B2] & "','" & [C2] & "','" & [D2] & "','" & [E2] & "','" & [F2] & "','" & [G2] & "','" & [H2] & "','" & [I2] & "','" & [J2] & "','" & [K2] & "','" & [L2] & "')"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing
End Sub

Charlize
11-07-2007, 06:47 AM
Provide me your testdata so that I can take a look at the setup.

So, the excelfile with coding + line of data that's not fully copied into acces and your acces database you want to use that has the table already defined the way you want it to be.

For the moment it's like holding a wet finger in the wind (if you get my point).

ps. if you post coding you can apply the VBA tags (that green square with vba in it) around those coding. It's a lot easier to read like that.

White_Nova
11-07-2007, 07:59 AM
Excel VBA below
Excel file attached



Sub AddData()
'Original coding from XLD
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\DataStore.mdb"
sSQL = "INSERT INTO Store (TIMEIN, MYDATE, MYSESSION,MANAGER, LEADNUMBER, CONSULTANT, PRIZE, ACTUALNUMBER, CHOSENNUMBER, TIMEOUT, DIFFERENCE, SURNAME) " & _
"VALUES ('" & [A2] & "','" & [B2] & "','" & [C2] & "','" & [D2] & "','" & [E2] & "','" & [F2] & "','" & [G2] & "','" & [H2] & "','" & [I2] & "','" & [J2] & "','" & [K2] & "','" & [L2] & "')"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing

End Sub


Your a huge help :banghead: :thumb

Charlize
11-07-2007, 12:35 PM
Where is your database ?

Charlize
11-07-2007, 01:15 PM
Everything seems to work fine for me. A little modification to pass string values to the database. The MYDATE field in the database is declared as a Date/Time value ? Anyway, here the codingSub AddData()
'Original coding from XLD
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\DataStore.mdb"
sSQL = "INSERT INTO Store (TIMEIN, MYDATE, MYSESSION, MANAGER, " & _
"LEADNUMBER, CONSULTANT, PRIZE, " & _
"ACTUALNUMBER, CHOSENNUMBER, TIMEOUT, " & _
"DIFFERENCE, SURNAME) " & _
"VALUES ('" & [A2].Text & "','" & [B2].Text & "','" & [C2].Text & _
"','" & [D2].Text & "','" & [E2].Text & "','" & [F2].Text & _
"','" & [G2].Text & "','" & [H2].Text & "','" & [I2].Text & _
"','" & [J2].Text & "','" & [K2].Text & "','" & [L2].Text & "')"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing
End Sub

White_Nova
11-07-2007, 11:00 PM
Hi Charlize

Working 100%!!!
Thanks a mil...

Is there a way to specify what the type of info is that you sending accross (i.e Date/Time, Text, Numbers)???

Charlize
11-08-2007, 01:06 AM
Everything must be sent over as a string. The value of the cell can be date, number, string, whatever type. And the cell is formatted as we want it to see. But we use the .Text property instead of the .Value property. It's because we are building a commandstring to be executed to achieve the result we want, namely adding info to a database. The database has the configuration of the field. If you declare mydate as a date/time field then the string that you sent over to the database will become a date/time type of info for the database.

If you want to retrieve info from the database, I think that you need a variable declared as a date otherwise you'll get an error (unless you put it directly into a worksheet).

White_Nova
11-08-2007, 05:55 AM
You an absolute champion Charlize!!!!!

I have tried this code to pull the Access query back to Excel but get the following error : User Defined Type not Defined.

Sub GetCn()
Set dbcon = New ADODB.Connection
dbcon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbfile & ";", _
"", ""
Set dbrs = New ADODB.Recordset
dbrs.Open sqlstr, dbcon
End Sub


Sub Access()
Dim adoconn As ADODB.Connection
Dim adors As ADODB.Recordset
Dim SQL As String
Dim filenm As String

SQL = "Select * From Store"
filenm = (ActiveWorkbook.Path & "\DataStore.mdb")
Call GetCn(adoconn, adors, SQL, filenm, "", "")

Dim xlSht As Excel.Worksheet
Set xlSht = Sheets("Access")
xlSht.Range("B2").CopyFromRecordset adors
adors.Close
adoconn.Close
Set adors = Nothing
Set adoconn = Nothing
Set xlSht = Nothing

End Sub

Please help.....

Charlize
11-08-2007, 07:00 AM
This one will do something to fetch all the data from store and put it in worksheet no 3. You have to set a reference (early binding). If I have more time i'll try to convert it to late binding.

ps.: This is a quick and dirty way but you get the results you want. It could be that some lines of coding aren't really necessary.Sub GetData()
'You have to set a reference to
'microsoft dao 3.6 object library
'Tested under excel 2003
Dim Db As Database
Dim Rs As Recordset
Dim Ws As Object
Dim i As Long
Dim MyPath As String

Set Ws = Worksheets(3)
'Set the Path to the database. This line is useful because
'if your database is in another location, you just need to change
'it here and the Path Variable will be used throughout the code
MyPath = ActiveWorkbook.Path & "\DataStore.mdb"
'This set of code will activate Sheet3 and clear any existing data
'After clearing the data it will select cell A1
Ws.Activate
Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Range("A1").Select
'Set the Database, and RecordSet This Table exists in the database
Set Db = Workspaces(0).OpenDatabase(MyPath, ReadOnly:=True)
'This will set the RecordSet to all records in the Store table
Set Rs = Db.OpenRecordset("Store")
'Set Rs = _
'Db.OpenRecordset("SELECT * FROM Store WHERE Mydate = '08/11/2007';")
'This loop will collect the field names and place them in the first
'row starting at "A1"
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next i
'The next line simply formats the headers to bold font
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True
'The next line will get the data from the recordset and copy it
'into the Worksheet (Sheet1).
Ws.Range("A2").CopyFromRecordset Rs
'This next code set will just select the data region and
'auto-fit the columns
Ws.Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Ws.Range("A1").Select
Rs.Close
Db.Close
End Sub

White_Nova
11-08-2007, 07:29 AM
You are an angel in desguise Charlize!!!!!

:bow: :bow: :bow: :bow: :bow: :hi:

White_Nova
11-08-2007, 07:37 AM
Please remind me to send you some flowers and a box of chocolates!!!!

White_Nova
11-12-2007, 01:43 AM
Hi Charlize

Really need your advise on this one please...
If i wanted to put the Excel file on a remote network machine and have the database on my machine how would i do that in the coding?

(As above)

Many thanks again for all your help...

Bob Phillips
11-12-2007, 02:40 AM
Instead of using the Activeworkbook.Path, use the network path



MyPath = "\\myserver\myShare" & "\DataStore.mdb"

White_Nova
11-12-2007, 03:19 AM
Hi there

I use this code and it gives me a "Expected expression" error

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= "\\10.0.1.3\\ABI (file://\\10.0.1.3\\ABI)" & "\DataStore.mdb & ActiveWorkbook.Path & "\DataStore.mdb"

Bob Phillips
11-12-2007, 03:29 AM
Instead of, not as well as



Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= "\\10.0.1.3\AB\DataStore.mdb"

White_Nova
11-12-2007, 03:33 AM
Its really not liking the "\\" part of the statement... any suggestions?

White_Nova
11-12-2007, 03:38 AM
Still giving an "Expression exprexcted error" while compiling...

Charlize
11-12-2007, 03:38 AM
Can you map the directory of the server where the database resides to a driveletter. What I mean is this :

1. \\10.0.1.3\AB (file://\\10.0.1.3\AB) mapping as drive Z: (but everybody must have permissions to that directory on the server. So the IT guys/girls do this on the server so that driveletter Z: points to that directory for everybody on the network.
2. In your coding use Z:\Datastore instead

Just an idea.

Bob Phillips
11-12-2007, 03:53 AM
If you have that networked drive mapped to a drive letter on your machine, try this routine to get the UNC path




Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias "WNetGetConnectionA" ( _
ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
lSize As Long) As Long

Const NO_ERROR As Long = 0
Const lBUFFER_SIZE As Long = 255

Function GetUNCPath(Driveletter As String) As String
Dim mpRemoteName As String
Dim lSize As Long
Driveletter = Driveletter & ":"
mpRemoteName = mpRemoteName & Space(lBUFFER_SIZE)
If WNetGetConnection32(Driveletter, _
mpRemoteName, _
lBUFFER_SIZE) = NO_ERROR Then
GetUNCPath = mpRemoteName
End If
End Function

White_Nova
11-12-2007, 03:53 AM
Thanks for your help again Charlize
Once again you have proved yourself ;-)

White_Nova
11-12-2007, 03:54 AM
Thanks for your help again Charlize
Once again you have proved yourself ;-)

:bow: :bow: :bow:

Bob Phillips
11-12-2007, 03:54 AM
Oops, I think I see it



Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=\\10.0.1.3\AB\DataStore.mdb"

Charlize
11-12-2007, 04:06 AM
xld, thanks for that nice piece of coding to get the path of a mapped directory.

White Nova, perhaps that your server has a name so that you can't refer to it with ip adresses but use the name of the server. If your server has the name server01 you could use \\server01 (file://\\server01). If AB is a user it is probably located under the users directory. So \\server01\users\AB (file://\\server01\users\AB) will get you to that users directory.

I could be wrong off course.

White_Nova
11-12-2007, 04:06 AM
Sounds better, but wehn running gives a path error, i have checked it!!!
Would like it this way though, would save time on the drive mapping idea...

Charlize
11-12-2007, 04:09 AM
:bow: :bow: :bow:Only three this time ???

White_Nova
11-12-2007, 04:09 AM
I would like to try xld's way but would like to know where i need to put that piece of coding he has provided above Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias "WNetGetConnectionA" ( _
ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
lSize As Long) As Long

Const NO_ERROR As Long = 0
Const lBUFFER_SIZE As Long = 255

Function GetUNCPath(Driveletter As String) As String
Dim mpRemoteName As String
Dim lSize As Long
Driveletter = Driveletter & ":"
mpRemoteName = mpRemoteName & Space(lBUFFER_SIZE)
If WNetGetConnection32(Driveletter, _
mpRemoteName, _
lBUFFER_SIZE) = NO_ERROR Then
GetUNCPath = mpRemoteName
End If
End Function

White_Nova
11-12-2007, 04:11 AM
Sorry Charlize, fingers are sore from trying to get this right!!!!
:bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow:

Charlize
11-12-2007, 04:21 AM
Option Explicit
Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias "WNetGetConnectionA" ( _
ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
lSize As Long) As Long

Const NO_ERROR As Long = 0
Const lBUFFER_SIZE As Long = 255

Sub test_path()
MsgBox "Z = " & GetUNCPath("Z")
End Sub
Function GetUNCPath(Driveletter As String) As String
Dim mpRemoteName As String
Dim lSize As Long
Driveletter = Driveletter & ":"
mpRemoteName = mpRemoteName & Space(lBUFFER_SIZE)
If WNetGetConnection32(Driveletter, _
mpRemoteName, _
lBUFFER_SIZE) = NO_ERROR Then
GetUNCPath = mpRemoteName
End If
End Function

Charlize
11-12-2007, 04:29 AM
:bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow: :bow:Much better ...:joy:

White_Nova
11-13-2007, 03:00 AM
I once again need your help please!!!

I have the access database with data inside it, i now have an excel template and would like to have the answers for the template produced from Access... how on earth do i do that???

Please help????

Charlize
11-13-2007, 03:31 AM
There are two ways you could do it.

1. The easy one is just getting every record (which you already have) and filter them when they are present in excel (but could cost extra time when there are a lot of records).
2. Building a selectif selection based on the where clausule. You'll have to check if you filled something in for every field. Depending on this your where section will differ.
Then you've got also 'or' and 'and' as you define the where's (where mydate = x and person = x . where mydate = x or person = x).

Also take a look at this site to see what kind of expressions are possible ... http://sqlcourse2.com/select2.html

White_Nova
11-13-2007, 03:45 AM
Thanks, and once the queries are ready in Access how do i bring the specific ones through to Excel?

White_Nova
11-13-2007, 04:10 AM
Alright, i have read through the website provided, very interesting...

Below is the code im tring to use to pull the info back to Excel...
Its very basic cause im not too sure...

Dim oConn As Object
Dim oRS As Object
Dim sSQL As String


Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= C:\Documents and Settings\Desktop\Database Info\Sales Telly Store.mdb"

SQL SELECT * from Query.Bookings



'Bookings
SELECT Data.TellyTeam, Count(Data.TellyTeam) AS CountOfTellyTeam
from Data
GROUP BY Data.TellyTeam;
'Confirmations
SELECT Data.TellyTeam, Count(Data.ConfCode) AS CountOfConfCode
from Data
GROUP BY Data.TellyTeam;
'Deals
SELECT Data.TellyTeam, Count(Data.Sale) AS CountOfSale
from Data
WHERE ((([Data]![Sale]) = "Y"))
GROUP BY Data.TellyTeam;
'Shows
SELECT Data.TellyTeam, Count(Data.AgtCode) AS CountOfAgtCode
from Data
GROUP BY Data.TellyTeam;

oConn.Execute sSQL
oConn.Close
Set oConn = Nothing

Charlize
11-13-2007, 04:32 AM
A wild guess that it's not doing what you want it to do. Take a look at my post where you were able to pull back all the data from a table. Along those lines (in green) is a small example of a where clause when mydate = 08/11/2007. If you want to see the bookings that are confirmed you'll have to query the database for the field confirmed to Y (if it's the field confirmed).

Group By is used to group by a field. So if you got some salespersons you can group by the field salesperson.

And every sql query that's doing something different has to be executed on his own (Deals ??? what's that)

If you explain in plain english what you want, cause I'm afraid that this coding will not work (I could be wrong off course).

White_Nova
11-13-2007, 04:39 AM
We have a telemarketing department that phones people and they come in for a presentation, they then get allocated to a salesperson who does or does not write a sale (Deal) from that person...

Tried the old VBA you sent

Sub GetData()
'You have to set a reference to
'microsoft dao 3.6 object library
'Tested under excel 2003
Dim Db As Database
Dim Rs As Recordset
Dim Ws As Object
Dim i As Long
Dim MyPath As String

Set Ws = Worksheets(2)
'Set the Path to the database. This line is useful because
'if your database is in another location, you just need to change
'it here and the Path Variable will be used throughout the code
MyPath = "C:\Documents and Settings\Russell\Desktop\Database Info\Sales Telly Store.mdb"
'This set of code will activate Sheet3 and clear any existing data
'After clearing the data it will select cell A1
Ws.Activate
Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Range("A1").Select
'Set the Database, and RecordSet This Table exists in the database
Set Db = Workspaces(0).OpenDatabase(MyPath, ReadOnly:=True)
'This will set the RecordSet to all records in the Store table
Set Rs = Db.OpenRecordset("Bookings")
'Set Rs = _
'Db.OpenRecordset("SELECT * FROM Store WHERE Mydate = '08/11/2007';")
'This loop will collect the field names and place them in the first
'row starting at "A1"
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next i
'The next line simply formats the headers to bold font
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True
'The next line will get the data from the recordset and copy it
'into the Worksheet (Sheet1).
Ws.Range("A2").CopyFromRecordset Rs
'This next code set will just select the data region and
'auto-fit the columns
Ws.Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Ws.Range("A1").Select
Rs.Close
Db.Close
End Sub

But is come up with a missmatch error.

I have created quesries in Access that already answer the template i have, i would just like to bring them back to excel...

Make sense???

White_Nova
11-13-2007, 05:31 AM
Hey there

I have ammeneded the code and think it will work but it gives me an error Run Time Error 13 a data type mismatch...

Sub GetData()
'You have to set a reference to
'microsoft dao 3.6 object library
'Tested under excel 2003
Dim Db As Database
Dim Rs As Recordset
Dim Ws As Object
Dim i As Long
Dim MyPath As String

Set Ws = Worksheets(2)
'Set the Path to the database. This line is useful because
'if your database is in another location, you just need to change
'it here and the Path Variable will be used throughout the code
MyPath = "C:\Documents and Settings\Russell\Desktop\Database Info\Sales Telly Store.mdb"
'This set of code will activate Sheet3 and clear any existing data
'After clearing the data it will select cell A1
Ws.Activate
Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Range("A1").Select
'Set the Database, and RecordSet This Table exists in the database
Set Db = Workspaces(0).OpenDatabase(MyPath, ReadOnly:=True)

sSQL = "SELECT" * "Data.TellyTeam, Count(Data.AgtCode) AS CountOfAgtCode FROM Data GROUP BY Data.TellyTeam;"
sSQL = "SELECT Data.TellyTeam, Count(Data.[NQ/Cat]) AS [CountOfNQ/Cat] FROM Data WHERE (([Data]![NQ/Cat] = Qual Or (Data.[NQ/Cat]) = QWOS Or (Data.[NQ/Cat]) = OF))GROUP BY Data.TellyTeam ORDER BY Data.TellyTeam;"
sSQL = "SELECT Data.TellyTeam, Count(Data.AgtCode) AS CountOfAgtCode FROM Data GROUP BY Data.TellyTeam;"
sSQL = "SELECT Data.TellyTeam, Count(Data.Sale) AS CountOfSale FROM Data WHERE ((([Data]![Sale]) = Y)) GROUP BY Data.TellyTeam;"
sSQL = "SELECT Data.TellyTeam, Count(Data.ConfCode) AS CountOfConfCode FROM Data GROUP BY Data.TellyTeam;"
sSQL = "SELECT Data.TellyTeam, Count(Data.TellyTeam) AS CountOfTellyTeam FROM Data GROUP BY Data.TellyTeam;"

'This next code set will just select the data region and
'auto-fit the columns
Ws.Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Ws.Range("A1").Select
Rs.Close
Db.Close
End Sub


Please help....

Charlize
11-13-2007, 05:51 AM
Give a sanitized version of your acces database and a layout of the result you wish to achieve.

- Even if you use 100 sql = statements, only the last one will be executed if you give the command

and you better use Db.OpenRecordset("SELECT * FROM Data WHERE Sale = 'Y';")and Data is the name of your table in the .mdb database.

By the way, your name is Russell ??? If not, it will not work for the path.

White_Nova
11-13-2007, 05:54 AM
Arent you on MSN so i can send you the database so you can see what im looking for?
Could speed things up just a little...

FYI - found this code which seems to do the trick

Dim SQL As String
Dim filenm As String
'Bookings
SQL = "Select * From Bookings"
' "C:\Documents and Settings\Bruce\My Documents\Databases\All Of Access\Ians Way.mdb"
filenm = (ActiveWorkbook.Path & "\Sales Telly Store.mdb")
Call GetCn(adoconn, adors, SQL, filenm, "", "")

Dim xlSht As Excel.Worksheet
Set xlSht = Sheets("Sheet2")
xlSht.range("B2").CopyFromRecordset adors
adors.Close
adoconn.Close
Set adors = Nothing
Set adoconn = Nothing
Set xlSht = Nothing

'Confirmations
SQL = "Select * From Confirmations"
' "C:\Documents and Settings\Bruce\My Documents\Databases\All Of Access\Ians Way.mdb"
filenm = (ActiveWorkbook.Path & "\Sales Telly Store.mdb")
Call GetCn(adoconn, adors, SQL, filenm, "", "")

Set xlSht = Sheets("Sheet2")
xlSht.range("D2").CopyFromRecordset adors
adors.Close
adoconn.Close
Set adors = Nothing
Set adoconn = Nothing
Set xlSht = Nothing
'Shows
SQL = "Select * From Shows"
' "C:\Documents and Settings\Bruce\My Documents\Databases\All Of Access\Ians Way.mdb"
filenm = (ActiveWorkbook.Path & "\Sales Telly Store.mdb")
Call GetCn(adoconn, adors, SQL, filenm, "", "")

Set xlSht = Sheets("Sheet2")
xlSht.range("F2").CopyFromRecordset adors
adors.Close
adoconn.Close
Set adors = Nothing
Set adoconn = Nothing
Set xlSht = Nothing
End Sub

Charlize
11-13-2007, 06:09 AM
When you've got some queries defined in Access. Maybe try this one. Don't promise a thing but you could try.Sub GetQueryDef()
'This sub will get data from an Existing QueryDef in
'database and place the data on sheet2.
Dim Db As Database
Dim Qd As QueryDef
Dim Rs As Recordset
Dim Ws As Worksheet
Dim i As Long
Dim Path As String
'Set the Path to the database
Path = "C:\yourfiledirectory\Sales and whatever.mdb"
'Set Ws
Set Ws = Sheets("Sheet2")

Ws.Activate
Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Range("A1").Select
'Set the Database and QueryDef. This QueryDef exists in the
'database.
Set Db = Workspaces(0).OpenDatabase(Path, ReadOnly:=True, _
Exclusive:=False)
'replace the name of your query with the real name
Set Qd = Db.QueryDefs("The name of your query")
'Create a new Recordset from the Query based on the stored
'QueryDef.
Set Rs = Qd.OpenRecordset()
'This loop will collect the field names and place them in the first
'row starting at "A1."
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next i
'This line simply sets the font to bold for the headers.
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True
'The next line will get the data from the recordset and copy it
'into the Worksheet (Sheet2).
Ws.Range("A2").CopyFromRecordset Rs
'This next code set will just select the data region and auto-fit
'the columns
Ws.Select
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Range("A1").Select
Qd.Close
Rs.Close
Db.Close
End Sub

White_Nova
11-13-2007, 07:04 AM
sorted with that one thanks!!!!!

I want to transfer a large amount of data back to my dtabase but i want to ammend the current data in there..

Code im trying is below

Sub Transfer()

Dim oConn As Object
Dim oRS As Object
Dim sSQL As String


Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= C:\Documents and Settings\Russell\Desktop\Database info\Sales Telly Store.mdb"

sSQL = "INSERT INTO Store (Uni again, Uni, Agtname, AgtCode, Surname, SessDate, Day, Session,LeadNo, Timein, weeknum, Income, Suburb, Age, Race, M, Sale, SOLID, SUSPENSIVE, DSD, Uvongo, QVCFinite, Units, ContrNumber, ManName, ManCode, DoorName, DoorCode, SemName, SemCode, TellyOp, Telycode, ConfName, ConfCode, TellyTeam, Prize1, Prize2, Prize3, Chosennumber, Actualnumber, Timeout, Lead count, Income average, Average inc, AV, AV2, 30-35, 35-40, 40-45, 1, 12, 13, AV3, Door, Sem, Man Alloc, Qual, NQ/Cat)" & _
"VALUES ('" & [A2].Text & "','" & [B2].Text & "','" & [C2].Text & _
"','" & [D2].Text & "','" & [E2].Text & "','" & [F2].Text & _
"','" & [G2].Text & "','" & [H2].Text & "','" & [I2].Text & _
"','" & [J2].Text & "','" & [K2].Text & "','" & [L2].Text & _
"','" & [M2].Text & "','" & [N2].Text & "','" & [O2].Text & _
"','" & [P2].Text & "','" & [Q2].Text & "','" & [R2].Text & _
"','" & [S2].Text & "','" & [T2].Text & "','" & [U2].Text & _
"','" & [V2].Text & "','" & [W2].Text & "','" & [X2].Text & _
"','" & [Y2].Text & "','" & [Z2].Text & "','" & [AA2].Text & _
"','" & [AB2].Text & "','" & [AC2].Text & "','" & [AD2].Text & _
"','" & [AE2].Text & "','" & [AF2].Text & "','" & [AG2].Text & _
"','" & [AH2].Text & "','" & [AI2].Text & "','" & [AJ2].Text & _
"','" & [AK2].Text & "','" & [AL2].Text & "','" & [AM2].Text & _
"','" & [AN2].Text & "','" & [AO2].Text & "','" & [AP2].Text & _
"','" & [AQ2].Text & "','" & [AR2].Text & "','" & [AS2].Text & _
"','" & [AT2].Text & "','" & [AU2].Text & "','" & [AV2].Text & _
"','" & [AW2].Text & "','" & [AX2].Text & "','" & [AY2].Text & _
"','" & [AZ2].Text & "','" & [BA2].Text & "','" & [BB2].Text & _
"','" & [BC2].Text & "','" & [BD2].Text & "','" & [BE2].Text & _
"','" & [BF2].Text & "')"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing
End Sub

Please help again!!!!
Your an angel...

Charlize
11-13-2007, 07:33 AM
I'll give you a hint for this one. But you better use a sample database for trial and error. The general idea is this
UPDATE table_name SET column_name = new_value WHERE column_name = some_valueUPDATE Bookings SET Paid = "Y" WHERE Confirmed = "Y", Name = "White_Nova"to replace data in a table. But you also need to check if there is more than one record that matches the where clausule.

So first check your database with the where clausule and if the record set is one (count them in your excel sheet), you're in business. If not, you'll need an additional qualifier to get a unique (single) record.

White_Nova
11-13-2007, 11:56 PM
Hi Charlize

Maybe getting carried away with the explination... lets try again...

I have an access database with a "Data" table, off that i am running queries whic i then bring into Excel...

The above is working 100%
The part i need help with is just updating new data into the "Data" table in access from Excel (there are 58 colombs of data)

Is this possible and if so how?

Thanks agian for all your help...

Charlize
11-14-2007, 02:09 AM
Hi Charlize

Maybe getting carried away with the explination... lets try again...

I have an access database with a "Data" table, off that i am running queries whic i then bring into Excel...

The above is working 100%Off course it's working.


The part i need help with is just updating new data into the "Data" table in access from Excel (there are 58 colombs of data)

Is this possible and if so how?Yes it's possible. Have you read my answer regarding the UPDATE thing. You'll have to use that instead of INSERT INTO. You can use the same coding as the INSERT INTO coding but you'll have to change the sql string to a UPDATE coding.

Try something, please. If you post your coding, I'll give you a working sample (yes, it's already coded and tested and it works like a charm. At least for my testdatabase - MyId, MyManager, MyDate, MySession).

White_Nova
11-14-2007, 02:12 AM
Hi Charlize

Managed to fiddle with it a bt and its working - your a real life saver, thanks!!!!

Say i have a database and a excel template front end and i wanted to bring back data to excel but accoring to a start and end date that i would specify in Excel... that possible???

Charlize
11-14-2007, 02:20 AM
Hi Charlize

Managed to fiddle with it a bt and its working - your a real life saver, thanks!!!!

Say i have a database and a excel template front end and i wanted to bring back data to excel but accoring to a start and end date that i would specify in Excel... that possible???Yes, use this at the openrecordset thing Db.OpenRecordset("SELECT * FROM Store WHERE Mydate >= '01/11/2007', Mydate <= '30/11/2007'")Maybe someone else is interested in your coding for the update part ...

White_Nova
11-14-2007, 02:40 AM
True that would work but i need to specify the dates in Excel and have Acce pull the data back, the specified dates will change o i cant hard code them...

Below please find my code for updating database in Access from Excel

Sub ADOFromExcelToAccess()
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=[location of database];"
Set rs = New ADODB.Recordset
rs.Open "[Name of Table in Access]", cn, adOpenKeyset, adLockOptimistic, adCmdTable
r = 5 'Starts at row specified
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("Field1") = Range("A" & r).Value
.Fields("Field2") = Range("B" & r).Value

' "Field1,Field2 - need to be replaced with th coloumb headings
' 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

Sheets("[Main Sheet Name]").Select
Range("A5").Select
MsgBox ("Data Transfered")



End Sub

Charlize
11-14-2007, 02:54 AM
This is my solution for the updatingSub Update_Data()
'This coding will update the active row
'You could set this in a worksheet change event
'to update your record when a change in the
'targetcell has been made.
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
Dim vId As String, vManager As String
Dim vDate As String, vSession As String

Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.Path & "\DataStore.mdb"

vId = Range("A" & ActiveCell.Row)
vManager = Range("B" & ActiveCell.Row)
vDate = Range("C" & ActiveCell.Row)
vSession = Range("D" & ActiveCell.Row)
'MyId is a unique identifier that you can't (may not) change
'Store is your database
'MyManager, MyDate and MySession are your fieldnames
'We update the record by using the unique MyId field
sSQL = "UPDATE Store Set MyManager = '" & vManager & _
"', MyDate = '" & vDate & _
"', MySession = '" & vSession & "' WHERE MyId = '" & vId & "'"
oConn.Execute sSQL
oConn.Close
Set oConn = Nothing
End SubUse variables instead of hard coded dates

White_Nova
11-14-2007, 03:59 AM
Missunderstanding????

In Excel cell(A1) i manually insert a start date, in Cell(A2) i manually insert a end date.

What i need is access to give me the data between these two dates???
Or to have a query in Access understand the two dates inserted by the user into Excel cell(A1,A2) and give me the queried data in Excel...

Is this possible and if so how?

Charlize
11-15-2007, 03:56 AM
Again, another piece of coding to play with. Problem with this one is that someone can fill some parts in or not and based on that we need to build the sql query to get to the recordset we want. Anyway, have fun with this one (I think you've got to give something more :bggift: than some flowers and a box of chocolate ...)Sub GetData_From_Certain_Date()
'You have to set a reference to
'microsoft dao 3.6 object library
'Tested under excel 2003
Dim Db As Database
Dim Rs As Recordset
Dim Ws As Object
Dim i As Long
Dim MyPath As String
Dim vStartDate As String
Dim sSql As String
'This is destination sheet if matching records found
Set Ws = Worksheets(3)
'Set the Path to the database. This line is useful because
'if your database is in another location, you just need to change
'it here and the Path Variable will be used throughout the code
MyPath = ActiveWorkbook.Path & "\DataStore.mdb"
'This set of code will activate Sheet3 and clear any existing data
'After clearing the data it will select cell A1
Ws.Activate
Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Range("A1").Select
'Set the Database, and RecordSet This Table exists in the database
Set Db = Workspaces(0).OpenDatabase(MyPath, ReadOnly:=True)
'Since we use the dd/mm/yyyy format, I need to rebuild the date
'string to filter on the acces database
If Worksheets(1).Range("F2").Text = vbNullString Then
vStartDate = ""
Else
'Dates have to be in between # marks
vStartDate = "WHERE MyDate = #" & _
Format(Worksheets(1).Range("F2").Text, "yyyy/mm/dd") _
& "#"
End If
sSql = "SELECT * FROM Store " & vStartDate
Set Rs = Db.OpenRecordset(sSql)
'This loop will collect the field names and place them in the first
'row starting at "A1"
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next i
'The next line simply formats the headers to bold font
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True
'The next line will get the data from the recordset and copy it
'into the Worksheet (Sheet1).
Ws.Range("A2").CopyFromRecordset Rs
'This next code set will just select the data region and
'auto-fit the columns
Ws.Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Ws.Range("A1").Select
Rs.Close
Db.Close
End Sub

White_Nova
11-15-2007, 11:23 PM
after all your help you just name what you want and ill see what i can do ;-)

This works 100% and is exactly what i needed thank you so so so so much for your help... we will be chatting again, will be having a few more project similar to this one and will need your beautiful brain to assist me...

Thanks again

Charlize
11-16-2007, 04:12 AM
after all your help you just name what you want and ill see what i can do ;-)You already said several times thank you. Alltough I was tempted, I don't ask you a thing. My only hope is that you have learned something from my postings (at least that my postings were understandable for you).


This works 100% and is exactly what i needed thank you so so so so much for your help... we will be chatting again, will be having a few more project similar to this one and will need your beautiful brain to assist me...If I could, I would ... If I can't, I'll try ...

Don't be mistaken about my brain, it's just as good as yours ...

White_Nova
11-21-2007, 01:17 AM
Hi Charlize

Need your brilliant brain again.

I have coding( Below) that im using to update a database with new records bases on a "Day" criteria...

I need to ammend this code to cater for updating as well as adding new records

The logic goes like this

If record exists then
Update records
Else
If Record does not exist then
Add new record

Please help

Sub ADOFromExcelToAccess()
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:\Documents and Settings\Russell\Desktop\Manager Program\DataStore.mdb;"
Set rs = New ADODB.Recordset
rs.Open "Store", cn, adOpenKeyset, adLockOptimistic, adCmdTable


Columns("A:B").Select
Selection.EntireColumn.Hidden = False



If Range("K1").Value = "Tues" Then

r = 5 'Starts at row specified
Do While (Range("C" & r).Formula) = "Tues"
' repeat until first empty cell in column A
With rs
'If Record.exists = True Then
.update ' updates an existing record
' add values to each field in the record
.Fields("Agent Name") = Range("A" & r).Value
.Fields("Week Number") = Range("B" & r).Value
.Fields("Day") = Range("C" & r).Value
.Fields("Ses") = Range("D" & r).Value
.Fields("Sale Discription") = Range("E" & r).Value
.Fields("Goal Per Ses") = Range("F" & r).Value
.Fields("Lead") = Range("G" & r).Value
.Fields("Pitch") = Range("H" & r).Value
.Fields("Made Sale") = Range("I" & r).Value
.Fields("Sales Can") = Range("J" & r).Value
.Fields("Sales Discription") = Range("K" & r).Value
.Fields("Units Written") = Range("L" & r).Value
.Fields("Goal Forcast") = Range("M" & r).Value
.Fields("Cont No") = Range("N" & r).Value
.Fields("Sus") = Range("O" & r).Value
.Fields("Ds Solid") = Range("P" & r).Value
.Fields("Normal Solid") = Range("Q" & r).Value

'Else
'If Record.exists = False Then

.AddNew ' updates an existing record
' add values to each field in the record
.Fields("Agent Name") = Range("A" & r).Value
.Fields("Week Number") = Range("B" & r).Value
.Fields("Day") = Range("C" & r).Value
.Fields("Ses") = Range("D" & r).Value
.Fields("Sale Discription") = Range("E" & r).Value
.Fields("Goal Per Ses") = Range("F" & r).Value
.Fields("Lead") = Range("G" & r).Value
.Fields("Pitch") = Range("H" & r).Value
.Fields("Made Sale") = Range("I" & r).Value
.Fields("Sales Can") = Range("J" & r).Value
.Fields("Sales Discription") = Range("K" & r).Value
.Fields("Units Written") = Range("L" & r).Value
.Fields("Goal Forcast") = Range("M" & r).Value
.Fields("Cont No") = Range("N" & r).Value
.Fields("Sus") = Range("O" & r).Value
.Fields("Ds Solid") = Range("P" & r).Value
.Fields("Normal Solid") = Range("Q" & r).Value


'End If
'End If
' add more fields if necessary...
.update ' stores the new record
End With
r = r + 1 ' next row
Loop

Else

If Range("K1").Value = "Wed" Then

r = 9 'Starts at row specified
Do While (Range("C" & r).Formula) = "Wed"
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Agent Name") = Range("A" & r).Value
.Fields("Week Number") = Range("B" & r).Value
.Fields("Day") = Range("C" & r).Value
.Fields("Ses") = Range("D" & r).Value
.Fields("Sale Discription") = Range("E" & r).Value
.Fields("Goal Per Ses") = Range("F" & r).Value
.Fields("Lead") = Range("G" & r).Value
.Fields("Pitch") = Range("H" & r).Value
.Fields("Made Sale") = Range("I" & r).Value
.Fields("Sales Can") = Range("J" & r).Value
.Fields("Sales Discription") = Range("K" & r).Value
.Fields("Units Written") = Range("L" & r).Value
.Fields("Goal Forcast") = Range("M" & r).Value
.Fields("Cont No") = Range("N" & r).Value
.Fields("Sus") = Range("O" & r).Value
.Fields("Ds Solid") = Range("P" & r).Value
.Fields("Normal Solid") = Range("Q" & r).Value
.update ' stores the new record
End With
r = r + 1 ' next row
Loop

Else

If Range("K1").Value = "Thurs" Then

r = 13 'Starts at row specified
Do While (Range("C" & r).Formula) = "Thurs"
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Agent Name") = Range("A" & r).Value
.Fields("Week Number") = Range("B" & r).Value
.Fields("Day") = Range("C" & r).Value
.Fields("Ses") = Range("D" & r).Value
.Fields("Sale Discription") = Range("E" & r).Value
.Fields("Goal Per Ses") = Range("F" & r).Value
.Fields("Lead") = Range("G" & r).Value
.Fields("Pitch") = Range("H" & r).Value
.Fields("Made Sale") = Range("I" & r).Value
.Fields("Sales Can") = Range("J" & r).Value
.Fields("Sales Discription") = Range("K" & r).Value
.Fields("Units Written") = Range("L" & r).Value
.Fields("Goal Forcast") = Range("M" & r).Value
.Fields("Cont No") = Range("N" & r).Value
.Fields("Sus") = Range("O" & r).Value
.Fields("Ds Solid") = Range("P" & r).Value
.Fields("Normal Solid") = Range("Q" & r).Value
' add more fields if necessary...
.update ' stores the new record
End With
r = r + 1 ' next row
Loop

Else

If Range("K1").Value = "Frid" Then

r = 17 'Starts at row specified
Do While (Range("C" & r).Formula) = "Frid"
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Agent Name") = Range("A" & r).Value
.Fields("Week Number") = Range("B" & r).Value
.Fields("Day") = Range("C" & r).Value
.Fields("Ses") = Range("D" & r).Value
.Fields("Sale Discription") = Range("E" & r).Value
.Fields("Goal Per Ses") = Range("F" & r).Value
.Fields("Lead") = Range("G" & r).Value
.Fields("Pitch") = Range("H" & r).Value
.Fields("Made Sale") = Range("I" & r).Value
.Fields("Sales Can") = Range("J" & r).Value
.Fields("Sales Discription") = Range("K" & r).Value
.Fields("Units Written") = Range("L" & r).Value
.Fields("Goal Forcast") = Range("M" & r).Value
.Fields("Cont No") = Range("N" & r).Value
.Fields("Sus") = Range("O" & r).Value
.Fields("Ds Solid") = Range("P" & r).Value
.Fields("Normal Solid") = Range("Q" & r).Value
.update ' stores the new record
End With
r = r + 1 ' next row
Loop

Else

If Range("K1").Value = "Sat" Then

r = 21 'Starts at row specified
Do While (Range("C" & r).Formula) = "Sat"
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Agent Name") = Range("A" & r).Value
.Fields("Week Number") = Range("B" & r).Value
.Fields("Day") = Range("C" & r).Value
.Fields("Ses") = Range("D" & r).Value
.Fields("Sale Discription") = Range("E" & r).Value
.Fields("Goal Per Ses") = Range("F" & r).Value
.Fields("Lead") = Range("G" & r).Value
.Fields("Pitch") = Range("H" & r).Value
.Fields("Made Sale") = Range("I" & r).Value
.Fields("Sales Can") = Range("J" & r).Value
.Fields("Sales Discription") = Range("K" & r).Value
.Fields("Units Written") = Range("L" & r).Value
.Fields("Goal Forcast") = Range("M" & r).Value
.Fields("Cont No") = Range("N" & r).Value
.Fields("Sus") = Range("O" & r).Value
.Fields("Ds Solid") = Range("P" & r).Value
.Fields("Normal Solid") = Range("Q" & 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 If
End If
End If
End If
End If
Columns("A:B").Select
Selection.EntireColumn.Hidden = True
End Sub

Charlize
11-21-2007, 02:15 AM
To make it simple to know if a record already exists, you could use a helper column to see if the row was already transferred to the database. If helper column has a mark, make selection of unique record and use this recordset to update the recordset, if helpercolumn hasn't got a checkmark, add a recordset.

You're using much the same coding. I would try to change it like this :
1. First see what's in K1 (Mon, Tue, Wed, Thu, Fri)
2. Put this in a stringvariable vDay and use this to do the looping
3. Based on that you store 5 or 9 or ... in r

This is an example of a possible solution (not tested, so be aware, try it first on a trial database)Sub ADOFromExcelToAccess()
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:\Documents and Settings\Russell\Desktop\Manager Program\DataStore.mdb;"
Set rs = New ADODB.Recordset
rs.Open "Store", cn, adOpenKeyset, adLockOptimistic, adCmdTable

Columns("A:B").Select
Selection.EntireColumn.Hidden = False
'Added a string for the day
Dim vDay As String
vDay = Range("K1").Value
Select Case vDay
Case "Tues"
r = 5
Case "Wed"
r = 9
Case "Thurs"
r = 13
Case "Frid"
r = 17
Case "Sat"
r = 21
End Select
Do While Range("C" & r).Value = vDay
'column M is helper column
If Range("C" & r).Offset(, 10).Value = "Ok" Then
' repeat until first empty cell in column A
With rs
'If Record.exists = True Then
.Update ' updates an existing record
' add values to each field in the record
.Fields("Agent Name") = Range("A" & r).Value
.Fields("Week Number") = Range("B" & r).Value
.Fields("Day") = Range("C" & r).Value
.Fields("Ses") = Range("D" & r).Value
.Fields("Sale Discription") = Range("E" & r).Value
.Fields("Goal Per Ses") = Range("F" & r).Value
.Fields("Lead") = Range("G" & r).Value
.Fields("Pitch") = Range("H" & r).Value
.Fields("Made Sale") = Range("I" & r).Value
.Fields("Sales Can") = Range("J" & r).Value
.Fields("Sales Discription") = Range("K" & r).Value
.Fields("Units Written") = Range("L" & r).Value
.Fields("Goal Forcast") = Range("M" & r).Value
.Fields("Cont No") = Range("N" & r).Value
.Fields("Sus") = Range("O" & r).Value
.Fields("Ds Solid") = Range("P" & r).Value
.Fields("Normal Solid") = Range("Q" & r).Value
Else
'If Record.exists = False Then
.AddNew ' updates an existing record
' add values to each field in the record
.Fields("Agent Name") = Range("A" & r).Value
.Fields("Week Number") = Range("B" & r).Value
.Fields("Day") = Range("C" & r).Value
.Fields("Ses") = Range("D" & r).Value
.Fields("Sale Discription") = Range("E" & r).Value
.Fields("Goal Per Ses") = Range("F" & r).Value
.Fields("Lead") = Range("G" & r).Value
.Fields("Pitch") = Range("H" & r).Value
.Fields("Made Sale") = Range("I" & r).Value
.Fields("Sales Can") = Range("J" & r).Value
.Fields("Sales Discription") = Range("K" & r).Value
.Fields("Units Written") = Range("L" & r).Value
.Fields("Goal Forcast") = Range("M" & r).Value
.Fields("Cont No") = Range("N" & r).Value
.Fields("Sus") = Range("O" & r).Value
.Fields("Ds Solid") = Range("P" & r).Value
.Fields("Normal Solid") = Range("Q" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
End If
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

Columns("A:B").Select
Selection.EntireColumn.Hidden = True
End Sub

White_Nova
11-21-2007, 02:42 AM
That looks good, interesting... one question though...
I have a template that i update the database with and it changes according to the agent name i put into it, so how would i determain which records have and have not been put into the database (Helper colomb)???
Its not possible becuase once i change the agents name on the template it will write new data to the database

Calculation = 4 sessions a day, 5 days a week, 52 weeks a year.
That is for 1 agent, there are a changing amount of agents.

What i have tried to do is to add a unique identifier to both Excel and Access, the problem is that i first have to insert data into access to be able to do a check on the code...

Charlize
11-21-2007, 03:01 AM
Can you make a sample of your template and how that you can see when a record is new or not. Or do you work with unique idno. Let's say my file is CHAR for charlize and then 01 for first fileno. How do you know that it's that file. Do they tell it to you ... or do you have to guess ? Or use CHAR-1. With split function it's easier to get the last no.

White_Nova
11-21-2007, 03:59 AM
Hi Charlize, dont think that is going to help... its what you do with the template and after thats confusing...

Imagine you have a sheet in Excel.
this sheet is layed out as the one attached.
You then select the week(I1), agent(J1) and day(K1) from a drop down menu.
You then fill in the information in the table.
Once you have done this you click on transfer the whole first section( depending on Day chosen(K1) goes to the database (A5:Q8)...

But say you need to go change something you just entered, so you go back and select the same week, agent and day and change what you need to change (now here comes the tricky part)
you then click on transfer, i would like it to go and see if that record for that week, agent, day exists already, if it does i want it to update but if it doesnt find it then it must add it as a new record.

Please help...

Charlize
11-23-2007, 03:39 AM
Well, after some thinking I've created this little thing to let you see what I mean. The trouble will be, how do you adjust this idea to be used with your template. Hope you'll have some fun with this. Two files in attached zip. They must reside in the same directory.

White_Nova
12-04-2007, 12:35 AM
Hi Once again, just a quick one

a sample of my code looks like this:

SQL = "SELECT * FROM [Workings]" & _
" Where [Workings].[AgtCode]='" & Range("F3").Value & "'" & _
" And (((Workings.Sesdate) Between #" & Range("A1").Value & "# And #" & Range("A2").Value & "#))"

I would like to know if i can have tyhe dates formatted in my code...
The problem im having is that once the data is in Access and a ask for it in Excel it does not bring back the right data due to the date format being wrong...

1. how do i set the date format in both Excel and access to be the same (Preferably dd/mm/yyy)

Thanks again

Charlize
12-04-2007, 01:13 AM
On the worksheet you fill in the dates in the format of dd/mm/yyyy, like 04/12/2007. In your coding you'll have to rearrange the format like this "WHERE MyDate BETWEEN #" & _
Format(Worksheets(1).Range("A1").Text, "yyyy/mm/dd") & "# AND #" & _
Format(Worksheets(1).Range("A2").Text, "yyyy/mm/dd") & "#"But it could be that the in between dates aren't included. You'll have to test on that one.

White_Nova
12-04-2007, 06:31 AM
is that the format that Access uses for dates set as text??

White_Nova
12-11-2007, 01:27 AM
Hi Charlize

I really hope you there...

I have an issue here i need your help on...

Im using the same as before, excel to update Access, i have this code to update data from excel to access, but there are 1 or two fields that are updating with a "-1" instead of the value in Excel...

Please help!!!!!

Sub UpdateData()


Dim SQL As String
Dim filenm As String

filenm = (ActiveWorkbook.Path & "\Store.mdb")

Dim conn As New ADODB.Connection
Dim rst As ADODB.Recordset
Dim rs As ADODB.Recordset


Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset
Set rs = New ADODB.Recordset

rst.CursorLocation = adUseClient
rst.CursorType = adOpenStatic
rst.LockType = adLockBatchOptimistic

conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & filenm & ";Persist Security Info=False"
conn.Open


Sheets("Access").Select



If Range("A2").Value <> "" Then

r = 2 'Starts at row specified
Do While (Range("A" & r).Formula) <> ""

rst.ActiveConnection = conn
rst.Open "SELECT [Store1].[Uni1] FROM [Store1]" & _
" Where [Store1].[Uni1]= '" & Range("AZ" & r).Value & "';"

If (rst.RecordCount > 0) Then

rst.Close

rst.ActiveConnection = conn
rst.Open "Update [Store1] " & _
"set [Club]='" & Range("A" & r).Value & "',[Dev]='" & Range("B" & r).Value & "',[Res]='" & Range("C" & r).Value & _
"',[Unit]='" & Range("D" & r).Value & _
"',[Mod]='" & Range("E" & r).Value & _
"',[Size]='" & Range("F" & r).Value & _
"',[RCI]='" & Range("G" & r).Value & _
"',[Sea]='" & Range("H" & r).Value & _
"',[Wee]='" & Range("I" & r).Value & _
"', [TranSt]='" & Range("J" & r).Value & _
"', [ShaCertno]='" & Range("K" & r).Value & _
"', [StocSource]='" & Range("L" & r).Value & _
"', [StartDate]='" & Range("M" & r).Value & _
"', [FinDate]='" & Range("N" & r).Value & _
"', [WeekType]='" & Range("O" & r).Value & _
"', [ArrDate]='" & Range("P" & r).Value & _
"', [Other2007]='" & Range("AC" & r).Value & "', [paidother2007]='" & Range("AD" & r).Value & "', [RentBud2008]='" & Range("AU" & r).Value & "', [RentPaid2008]='" & Range("AV" & r).Value & "', [PaidRent2008]='" & Range("AW" & r).Value & "', [RentInvNo2008]='" & Range("AX" & r).Value & "', [OustRent2008]='" & Range("AY" & r).Value & "', [Uni1]='" & Range("AZ" & r).Value & "', [RentBud2007]='" & Range("AE" & r).Value & "', [RentPaid2007]='" & Range("AF" & r).Value & "', [PaidRent2007]='" & Range("AG" & r).Value & "', [RentinvNo2007]='" & Range("AH" & r).Value & "', [OustRent2007]='" & Range("AI" & r).Value & "', [Levy2006]='" & Range("AJ" & r).Value & "', [ResCode]='" & Range("AK" & r).Value & "', [LevyBud2008]='" & Range("AL" & r).Value & "', [LevyPaid2008]='" & Range("AM" & r).Value & "', [PaidLevy2008]='" & Range("AN" & r).Value & "', [InvNo2008]='" & Range("AO" & r).Value & "', [OustLevy2008]='" & Range("AP" & r).Value & "', [SpecLevy2008]='" & Range("AQ" & r).Value & _
"', [DepDate]='" & Range("Q" & r).Value & _
"', [OrigCurrency]='" & Range("R" & r).Value & _
"', [StocAgNo]='" & Range("S" & r).Value & "', [PaidSpecLevy2008]='" & Range("AR" & r).Value & "', [Other2008]='" & Range("AS" & r).Value & "', [PaidOther2008]='" & Range("AT" & r).Value & _
"', [ManFee]='" & Range("T" & r).Value & "' & [MemFee]='" & Range("U" & r).Value & _
"', [LevyBud2007]='" & Range("V" & r).Value & _
"', [LevyPaid2007]='" & Range("W" & r).Value & "' & [PaidLevy2007]='" & Range("X" & r).Value & "' & [InvNo2007]='" & Range("Y" & r).Value & "' & [OustLevy2007]='" & Range("Z" & r).Value & "', [SpecLevy2007]='" & Range("AA" & r).Value & "', [PaidSpecLevy2007]='" & Range("AB" & r).Value & _
"', [ResortCodeID]='" & Range("BB" & r).Value & _
"', [ClubID]='" & Range("BA" & r).Value & "', [Type]='" & Range("BC" & r).Value & _
"' WHERE [Store1].[Uni1]='" & Range("AZ" & r).Value & "'"



Else
rst.Close
rs.Open "Store1", conn, adOpenKeyset, adLockOptimistic, adCmdTable
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Club") = Range("A" & r).Value
.Fields("Dev") = Range("B" & r).Value
.Fields("Res") = Range("C" & r).Value
.Fields("Unit") = Range("D" & r).Value
.Fields("Mod") = Range("E" & r).Value
.Fields("Size") = Range("F" & r).Value
.Fields("RCI") = Range("G" & r).Value
.Fields("Sea") = Range("H" & r).Value
.Fields("Wee") = Range("I" & r).Value
.Fields("TranSt") = Range("J" & r).Value
.Fields("ShaCertNo") = Range("K" & r).Value
.Fields("StocSource") = Range("L" & r).Value
.Fields("StartDate") = Range("M" & r).Value
.Fields("FinDate") = Range("N" & r).Value
.Fields("WeekType") = Range("O" & r).Value
.Fields("ArrDate") = Range("P" & r).Value
.Fields("DepDate") = Range("Q" & r).Value
.Fields("OrigCurrency") = Range("R" & r).Value
.Fields("StocAgNo") = Range("S" & r).Value
.Fields("ManFee") = Range("T" & r).Value
.Fields("MemFee") = Range("U" & r).Value
.Fields("LevyBud2007") = Range("V" & r).Value
.Fields("LevyPaid2007") = Range("W" & r).Value
.Fields("PaidLevy2007") = Range("X" & r).Value
.Fields("InvNo2007") = Range("Y" & r).Value
.Fields("OustLevy2007") = Range("Z" & r).Value
.Fields("SpecLevy2007") = Range("AA" & r).Value
.Fields("PaidSpecLevy2007") = Range("AB" & r).Value
.Fields("Other2007") = Range("AC" & r).Value
.Fields("Paidother2007") = Range("AD" & r).Value
.Fields("RentBud2007") = Range("AE" & r).Value
.Fields("RentPaid2007") = Range("AF" & r).Value
.Fields("PaidRent2007") = Range("AG" & r).Value
.Fields("RentInvNo2007") = Range("AH" & r).Value
.Fields("OustRent2007") = Range("AI" & r).Value
.Fields("Levy2006") = Range("AJ" & r).Value
.Fields("ResCode") = Range("AK" & r).Value
.Fields("LevyBud2008") = Range("AL" & r).Value
.Fields("LevyPaid2008") = Range("AM" & r).Value
.Fields("PaidLevy2008") = Range("AN" & r).Value
.Fields("InvNo2008") = Range("AO" & r).Value
.Fields("OustLevy2008") = Range("AP" & r).Value
.Fields("SpecLevy2008") = Range("AQ" & r).Value
.Fields("PaidSpecLevy2008") = Range("AR" & r).Value
.Fields("Other2008") = Range("AS" & r).Value
.Fields("PaidOther2008") = Range("AT" & r).Value
.Fields("RentBud2008") = Range("AU" & r).Value
.Fields("RentPaid2008") = Range("AV" & r).Value
.Fields("PaidRent2008") = Range("AW" & r).Value
.Fields("RentInvno2008") = Range("AX" & r).Value
.Fields("OustRent2008") = Range("AY" & r).Value
.Fields("Uni1") = Range("AZ" & r).Value
.Fields("ClubID") = Range("BA" & r).Value
.Fields("ResortCodeID") = Range("BB" & r).Value
.Fields("Type") = Range("BC" & r).Value
.Update
End With

' stores the new record

rs.Close



End If
r = r + 1 ' next row




Loop



End If

End Sub

Charlize
12-11-2007, 05:52 AM
Which of those fields are getting the wrong values. What is the value in excel and how are those fields defined in the accesstable (date, boolean, text, number ...) ?

White_Nova
12-11-2007, 10:55 PM
Morning Charlize

The field i can see are ManFee and Memfee
They are set as "text" in access (have tried "Number" too)
The values are defined by what is inserted in excel, Eg 1000

Thanks

White_Nova
01-07-2008, 03:48 AM
any answers to this one???