Hi Rick, I'm glad it was of use.
Owen --- In [email protected], "Rick" <[EMAIL PROTECTED]> wrote: > Owen, > > Thanks for the code example. With some adjustments and tweaks it > fits my needs perfectly. > > My project lead wanted to thank you, too! > > Rick > > --- In [email protected], "owen_group_profile" > <[EMAIL PROTECTED]> wrote: > > no problems. > > > > I'm on GMT though so am just about to head home for the day, will > > check in again tomorrow morning. > > > > btw - you'll need to add two references to the database: > > > > microsoft DAO 3.6 library > > microsoft excel x library > > > > Owen > > > > > > > > --- In [email protected], "Rick" <[EMAIL PROTECTED]> > wrote: > > > Thanks, Owen! I'm going to digest this over lunch and get back > to > > > you with any questions. > > > > > > Rick > > > > > > --- In [email protected], "owen_group_profile" > > > <[EMAIL PROTECTED]> wrote: > > > > > > > > Hi Rick, > > > > > > > > the code below was run from Access. > > > > > > > > It opens a table (Tbl_EPR) in a recordset, then it opens an > Excel > > > > spreadsheet and covers rows 1 to 100, extracting the > information > > > from > > > > certain columns. > > > > > > > > At the end of each row it writes the data to a record in an > access > > > > table and then moves to the next column. > > > > > > > > This repeats for 13 worksheets within the workbook, all the > data > > > being > > > > transferred to one table. > > > > > > > > Apologies for the lack of notes in the code, I'm happy to > answer any > > > > questions you have about it though. > > > > > > > > hope it helps, > > > > Owen > > > > > > > > > > > > > > > > --------------------------------------------- > > > > Private Sub btn_Import_Click() > > > > Dim xlApp As Excel.Application > > > > Dim wb As Excel.Workbook > > > > Dim WriteRS As DAO.Recordset > > > > Dim db As DAO.Database > > > > > > > > DoCmd.SetWarnings (0) > > > > DoCmd.RunSQL "DELETE FROM Tbl_EPR" > > > > DoCmd.SetWarnings (-1) > > > > > > > > Set db = CurrentDb > > > > Set WriteRS = db.OpenRecordset("tbl_EPR", dbOpenDynaset) > > > > Set xlApp = CreateObject("Excel.Application") > > > > Set wb = xlApp.Workbooks.Open("P:\Roger\revenue\MMPR.xls") > > > > > > > > > > > > > > > > Dim col As Integer > > > > Dim row As Integer > > > > Dim WorksheetName As String > > > > Dim acctNo As String > > > > Dim CoName As String > > > > Dim acctMan As String > > > > Dim revenue As String > > > > Dim Products As String > > > > Dim currentMonth As String > > > > Dim lastrow As Integer > > > > > > > > > > > > > > > > Dim Y As Integer > > > > Y = 1 > > > > > > > > > > > > Do While Y <= 13 > > > > > > > > > > > > wb.Worksheets(Y).Activate > > > > > > > > row = 3 > > > > Do While row <= 100 > > > > acctNo = wb.Worksheets(Y).Cells(row, 2).Value > > > > CoName = wb.Worksheets(Y).Cells(row, 1).Value > > > > acctMan = wb.Worksheets(Y).Cells(row, 3).Value > > > > revenue = wb.Worksheets(Y).Cells(row, 17).Value > > > > > > > > > > > > col = 4 > > > > Do While col <= 17 > > > > If wb.Worksheets(Y).Cells(row, col) <> "" Then > > > > If Products = "" Then > > > > Products = wb.Worksheets(Y).Cells(2, col).Value > > > > Else > > > > Products = Products & ", " & wb.Worksheets(Y).Cells > (2, > > > > col).Value > > > > End If > > > > End If > > > > col = col + 1 > > > > Loop > > > > > > > > With WriteRS > > > > .AddNew > > > > !Acct_no = acctNo > > > > !name = CoName > > > > !Acct_Man = acctMan > > > > If revenue <> "" Then > > > > !Total = revenue > > > > End If > > > > !Products = Products > > > > !monthdue = wb.Worksheets(Y).name > > > > .Update > > > > End With > > > > Products = "" > > > > acctNo = "" > > > > CoName = "" > > > > acctMan = "" > > > > revenue = "" > > > > row = row + 1 > > > > Loop 'end row 3 - last row > > > > > > > > Y = Y + 1 'end worksheets > > > > Loop > > > > > > > > wb.Close > > > > Set WriteRS = Nothing > > > > Set xlApp = Nothing > > > > Set db = Nothing > > > > ------------------------------------------------ Yahoo! Groups Links <*> To visit your group on the web, go to: http://groups.yahoo.com/group/AccessVBACentral/ <*> To unsubscribe from this group, send an email to: [EMAIL PROTECTED] <*> Your use of Yahoo! Groups is subject to: http://docs.yahoo.com/info/terms/
