Excel Sheets From Access Table
If you’ve ever faced the challenge of exporting data from Microsoft Access into Excel, you’re not alone! One of the most common requests is to organize data by categories, like exporting car makes into separate Excel sheets or even separate Excel files. I’ve tackled this problem head-on and developed a step-by-step guide that allows you to export data from Access into separate Excel sheets with just a few lines of VBA code. Whether you’re a seasoned Access user or just starting with VBA, I’ve provided everything you need to create this solution yourself, completely free of charge. 🆓
The instructions are easy to follow, and there’s even a video demonstration that walks you through the process. However, if you’re short on time or just prefer a ready-to-use solution, I’ve got you covered! On my website, you can download a pre-built version of this tool. It’s the same tried-and-tested solution, but packaged up and ready to go—just a few clicks away from transforming how you handle your data.
OP “avalve” asked this question on Access World Forums:- “Howdy! Let me make a small scenario. Let’s say I have a table with fields CarMake/CarModel/Year/Color. What I am trying to do is to export the table to a single Excel Workbook with each CarMake having their own page displaying only their results”.
I don’t have much experience when it comes to manipulating Excel from MS Access, it’s an area I need some improvement! So I thought well here’s a challenge! I also had a bit of a leg up because I recently found some excellent code for manipulating Excel from MS Access and realised it would be a good basis in which to undertake answering this question.
Export Query into Separate Excel Sheets
Export Query into Separate Excel Sheets
Video 1 (01:41)
With this sample database from Nifty Access I demonstrate how you can take different sets of records from an MS Access table and show each different set on a separate spreadsheet page in Excel. The file is:- Export Query into Separate Excel Sheets – Nifty Access
Video 1 (01:41)
Play Video
… …
Export 45000 Rows to 286 Sheets
Export 45000 Rows to 286 Sheets
Video 2 (2:08)
This is really COOL!
Watch this Code (Available Below) import 45000 records from an MS Access database into an Excel spreadsheet. Not a straightforward import, as the import routine places individual groups of DATA in individual sheets! The MS Access table contains around 45000 rows of data relating to individual car Models. Each model is in a “Make” Group, and there are 286 Makes. Each individual Excel sheet created represent a “Make of Car” and there are “286 Makes of Cars”. Therefore the import routine creates 286 spreadsheet pages! Watch the video it’s impressive!Video 2 (2:08)
Play Video
… …
Query to Excel Sheets - Hows It Done?
Query to Excel Sheets - Hows It Done?
Video 3 (8:04)
How’s it done? In this video I go through the code, pointing out some of it’s features. I demonstrate how to create the SQL Statements necessary to get the code to run. If this is of interest, then below you will see the code. Just paste it into a Form, create the relevant SQL in the query designer grid and place that in the relevant place in the code, and away you go. If you’re not o fey with VBA coding, then I have a drop-in component, just copy the Form into your database, select the table, select the field you want to become sheet names in Excel, and away you go! The Drop-in Version can be downloaded HERE:-
Video 3 (8:04)
Play Video
… …
Free Code Version Here
Copy the block of code below and place in a Form. Place a Command Button named:- “btnRunMoveToXL” on the Form to call the Code. Get the DataSet, (the Table of vehicles) from the link provided. https://www.ebay.co.uk/pages/help/sell/contextual/master-vehicle-list-manually.html
(please note eBay’s conditions on using this data)
The “Master Vehicle List” is in text format… (without an ID field). You need to ADD the ID as an AutoNumber field.
Using the big data set of 45000 vehicles I discovered a bug. The code failed when it got to “Ford” because the next car name “Ford Asia/Oceania” (Used for the Excel Sheet Name) contained a special character, in particular “/”… To fix this issue I added another function “fStripIllegal” This function removes the non-standard characters from a text string.
Incidentally, if you read Minty’s comments you will find that he uses this function himself for exactly the same use I put it to, namely to correctly format VBA created sheet names in Excel…
Steps to Create this Yourself
- Download the eBay vehicle list (Excel File)
- Import the Vehicle List into MS Access
- Add an auto number field to it
- Name the auto number field “ID”
- Name the rest of the fields as indicated in the video
- Create a Form with the command button “btnRunMoveToXL”
I think that’s about it if I’ve missed anything just check the video and let me know and I will fix it!
If you have any problems, then post your questions in Access World Forums (AWF) in this thread:- https://www.access-programmers.co.uk/forums/showthread.php?t=303587 alternatively there is a paid-for version which is hosted on a Digital Downloads Site.
Option Compare Database
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'>>> Database by Tony Hine, alias Uncle Gizmo <<<
'>>> Created Feb, 2019 <<<
'>>> Last up-dated Feb, 2019 <<<
'>>> Telephone International: +44 7747 018 875 <<<
'>>> Telephone UK: 07747 018 875 <<<
'>>> e-mail: tonyhine@lay-away.co.uk <<<
'>>> Skype: unclegizmo (I seldom Use Skype) <<<
'>>> I post at the following forum (mostly) : <<<
'>>> http://www.access-programmers.co.uk/forums/ (alias Uncle Gizmo) <<<
'>>> If my e-mail don't work, try this website: http://www.tonyhine.co.uk/example_help.htm <<<
'>>> This is my public playground Website for MS Access:- <<<
'>>> The Nifty Access Website is sales orientated:- <<<
'>>> www.niftyaccess.com (A vehicle for me to generate an income for my retirement) <<<
'>>> My YouTube Channel HERE:- https://www.youtube.com/user/UncleGizmo <<<
'>>> CODE SUPPLIED NOT CHECKED AND TESTED FOR ERRORS!!!! Be Warned <<<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'OP Question Here:- https://www.access-programmers.co.uk/forums/showthread.php?t=303587
'Adapted by Uncle Gizmo - From:- https://btabdevelopment.com/export-a-table-or-query-to-excel/
'Vehicle DataSet found at:- https://www.ebay.co.uk/pages/help/sell/contextual/master-vehicle-list-manually.html
'Other Usful Tips
'https://wellsr.com/vba/2016/excel/4-useful-vba-delete-worksheet-macro-examples/
'https://www.access-programmers.co.uk/forums/threads/code-to-replace-special-character-with-space.278238/#post-1701099
'*******************************************************************************************************
'*******************************************************************************************************
'*******************************************************************************************************
'############## ---------------- Control Events ---------------------- ########
Private Sub btnRunMoveToXL_Click()
'Add a Button to your form to Call this
Call fRSL_XL_SheetsFromTbl
End Sub 'btnRunMoveToXL_Click
'############## ---------------- Primary Routines -------------------- ########
Private Sub fRSL_XL_SheetsFromTbl()
'RSL = Record Set Loop
Dim strSubName As String
Dim strModuleName As String
strSubName = "fRSL_XL_SheetsFromTbl"
strModuleName = "Form - " & Me.Name
On Error GoTo Error_Handler
Dim curDB As DAO.Database
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
'Dim lngTable As Long
Dim strCarMake As String
Dim strSQL_RSL As String
Set curDB = CurrentDb
strSQL_RSL = "SELECT DISTINCT Make1 FROM tblCars"
Set rst1 = curDB.OpenRecordset(strSQL_RSL, dbOpenForwardOnly)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True
Do Until rst1.EOF
strCarMake = rst1!Make1
Set rst2 = CurrentDb.OpenRecordset(fSQL_FillSheetWith(strCarMake))
'Add Extra Worksheet by moving over 1 on each iteration
Set xlWSh = xlWBk.sheets.Add(After:=xlWBk.Worksheets(xlWBk.Worksheets.Count))
'Update 2020_06_10 to Remove Illegal Characters From Excel Sheet Name
'Note:- http://www.excelcodex.com/2012/06/worksheets-naming-conventions/
xlWSh.Name = fStripIllegal(strCarMake)
xlWSh.Activate
xlWSh.Range("A1").Select
'Get the Headings from the Recordset
For Each fld In rst2.Fields
'Update to Remove Illegal Characters From Excel Sheet Name
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst2.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst2
xlWSh.Range("1:1").Select
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst1.MoveNext
Loop
'Remove the auto generated Sheet Sheet1
For Each xlWSh In xlWBk.Worksheets
If xlWSh.Name = "Sheet1" Then
xlWSh.Delete
End If
Next xlWSh
Exit_ErrorHandler:
rst1.Close
Set rst1 = Nothing
rst2.Close
Set rst2 = Nothing
Set curDB = Nothing
Exit Sub
Error_Handler: 'Version - 1a
Dim strErrFrom As String
Dim strErrInfo As String
strErrFrom = "Error From:-" & vbCrLf & strModuleName & vbCrLf & "Subroutine >>>>>>> " & strSubName
strErrInfo = "" & vbCrLf & "Error Number >>>>> " & Err.Number & vbCrLf & "Error Descscription:-" & vbCrLf & Err.Description
Select Case Err.Number
Case -2147417848 'The object invoked has disconnected from its clients. .
MsgBox "This error can occur if you close the Excel spreadsheet before the code finishes." & vbCrLf & vbCrLf & strErrFrom & strErrInfo
Case 3265 'Item not found in this collection.
MsgBox "This Error is usually caused when your Record Set Loop (RSL) has the wrong name for one of the fields in the table." & vbCrLf & vbCrLf & strErrFrom & strErrInfo
Case 3061 'Too few parameters. Expected 1.
MsgBox "This error occurred when the ID field was set to short text instead of AutoNumber." & vbCrLf & vbCrLf & strErrFrom & strErrInfo
Case 91 'Object variable or With block variable not set.
MsgBox "Lots of things can cause this error. In this Routine it occurred when the ID field was set to short text instead of AutoNumber." & vbCrLf & vbCrLf & strErrFrom & strErrInfo
Case 424 'Object required.
MsgBox "This error can occur if you close the Excel spreadsheet before the code finishes." & vbCrLf & vbCrLf & strErrFrom & strErrInfo
Case Else
MsgBox "Case Else Error" & vbCrLf & vbCrLf & strErrFrom & strErrInfo
End Select
Resume Exit_ErrorHandler
End Sub 'fRSL_XL_SheetsFromTbl
'############## ---------------- SQL Statements ---------------------- ########
Private Function fSQL_FillSheetWith(ByVal strCarMake As String) As String
Dim strSubName As String
Dim strModuleName As String
Dim conAppName As String
conAppName = "(Replace this Local Variable with a Global One) "
strSubName = "fSQL_FillSheetWith"
strModuleName = "Form - " & Me.Name
On Error GoTo Error_Handler
Dim strSQL0 As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String
'MsgBox " >>> " & strCarMake
''Format Text Correctly for the SQL Statement
strCarMake = Chr(34) & strCarMake & Chr(34) '"
'MsgBox " >>> " & strCarMake
'SELECT ID, Make1, Model1, Variant1, BodyStyle1, Type1, Year1, Engine1, [K-Type]
'FROM tblCars
'WHERE (((Make1)=
'"BMW"
'));
'Import this DataSet:-
'Vehicle Dataset found at:- https://www.ebay.co.uk/pages/help/sell/contextual/master-vehicle-list-manually.html
'in to a Table named "tblCars in your MS Access Database"
'Make sure the table has these field Headings:- ID, Make1, Model1, Variant1, BodyStyle1, Type1, Year1, Engine1, [K-Type]
'Make sure the ID field Data Type is AutoNumber and the rest are Short Text:-
'ID As AutoNumber
'Make1, Model1, Variant1, BodyStyle1, Type1, Year1, Engine1, [K-Type] as Short Test
strSQL1 = "SELECT ID, Make1, Model1, Variant1, BodyStyle1, Type1, Year1, Engine1, [K-Type] "
strSQL2 = "FROM tblCars "
strSQL3 = "WHERE (((Make1)="
'"BMW"
strSQL4 = "));"
strSQL0 = strSQL1 & strSQL2 & strSQL3 & strCarMake & strSQL4
fSQL_FillSheetWith = strSQL0
Exit_ErrorHandler:
Exit Function
Error_Handler:
Dim strErrFrom As String
Dim strErrInfo As String
strErrFrom = "Error From:-" & vbCrLf & strModuleName & vbCrLf & "Subroutine >>>>>>> " & strSubName
strErrInfo = "" & vbCrLf & "Error Number >>>>> " & Err.Number & vbCrLf & "Error Descscription:-" & vbCrLf & Err.Description
Select Case Err.Number
Case 0.123 'When Required, Replace Place Holder (1) with an Error Number
MsgBox "Error produced by Place Holder please check your code!" & vbCrLf & vbCrLf & strErrFrom & strErrInfo, , conAppName
Case Else
MsgBox "Case Else Error" & vbCrLf & vbCrLf & strErrFrom & strErrInfo, , conAppName
End Select
Resume Exit_ErrorHandler
End Function 'fSQL_FillSheetWith
'############## ---------------- Helper Routines --------------------- ########
Function fStripIllegal(strCheck As String, Optional strReplaceWith As String = "") As String
'https://www.access-programmers.co.uk/forums/threads/code-to-replace-special-character-with-space.278238/
On Error GoTo StripIllErr
'illegal file name characters included in default string are ? [ ] / = + < > :; * " , '
Dim intI As Integer
Dim intPassedString As Integer
Dim intCheckString As Integer
Dim strChar As String
Dim strIllegalChars As String
Dim intReplaceLen As Integer
If IsNull(strCheck) Then Exit Function
strIllegalChars = "?[]/=+<>:;,*" & Chr(34) & Chr(39) & Chr(13) & Chr(10) 'add/remove characters you need removed to this string
intPassedString = Len(strCheck)
intCheckString = Len(strIllegalChars)
intReplaceLen = Len(strReplaceWith)
If intReplaceLen > 0 Then 'a character has been entered to use as the replacement character
If intReplaceLen = 1 Then 'check the character itself isn't an illegal character
If InStr(strIllegalChars, strReplaceWith) > 0 Then
MsgBox "You can't replace an illegal character with another illegal character", _
vbOKOnly + vbExclamation, "Invalid Character"
fStripIllegal = strCheck
Exit Function
End If
Else 'only one replacement character allowed
MsgBox "Only one character is allowed as a replacement character", _
vbOKOnly + vbExclamation, "Invalid Replacement String"
fStripIllegal = strCheck
Exit Function
End If
End If
If intPassedString < intCheckString Then
For intI = 1 To intCheckString
strChar = Mid(strIllegalChars, intI, 1)
If InStr(strCheck, strChar) > 0 Then
strCheck = Replace(strCheck, strChar, strReplaceWith)
End If
Next intI
Else
For intI = 1 To intPassedString
strChar = Mid(strIllegalChars, intI, 1)
If InStr(strCheck, strChar) > 0 Then
strCheck = Replace(strCheck, strChar, strReplaceWith)
End If
Next intI
End If
fStripIllegal = Trim(strCheck)
StripIllErrExit:
Exit Function
StripIllErr:
MsgBox "The following error occured: " & Err.Number & vbCrLf _
& Err.Description, vbOKOnly + vbExclamation, "Unexpected Error"
fStripIllegal = strCheck
Resume StripIllErrExit
End Function 'fStripIllegal
