Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6
Default Repost! Excel multiple worksheet populate from recordset

Using Access2000, the sample code below is what I have been modifying and
working on since the past week and I could not get it to work properly.

What I wanted to accomplish:
1) read from a recordset and export to Excel
2) Excel is populated based from an ID (may possible be one or multiple) and
renames the worksheet based from the ID
3) the code also format the fields

The sample database may be downloaded at:
http://www.geocities.com/mgtulips/sample_db.mdb

TIA!
Bob


Dim db As Database 'used to reference the current database
Dim rs As Recordset, rsID As Recordset
Dim qDef As QueryDef
Dim xlApp As Object, wkb As Object, wks As Object
Dim sCarrier As String, sMPC As String
Dim i As Integer, intSPID As Integer
Dim strSQL As String, strSQL2 As String
Dim iWorksheets As Integer, x As Integer


Set db = CurrentDb() 'initialize the database variable to this
database
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

Set rsID = db.OpenRecordset("qryID", dbOpenDynaset)
Set wkb = xlApp.Workbooks.Add

iWorksheets = DCount("*", "qryID")
Set wks = wkb.ActiveSheet

Do While Not rsID.EOF
For x = 1 To iWorksheets
'Go to Next Worksheet
Worksheets(x).Activate

strSQL2 = "SELECT rank, desc, inv_current, inv_previous, inv_variance,"
strSQL2 = strSQL2 & " ytd_current, ytd_previous, ytd_variance,"
strSQL2 = strSQL2 & " market_share_current, market_share_previous,
share_vs_ly"
strSQL2 = strSQL2 & " FROM tmp_result_all"
strSQL2 = strSQL2 & " WHERE id = '" & rsID("id").Value & "'"
Set rs = db.OpenRecordset(strSQL2, dbOpenDynaset)

'format the excel report
wks.Range("A1:A3").Font.Bold = True
wks.Range("A1:A3").Font.Size = 10
wks.Range("A1:A3").Font.Color = RGB(255, 0, 0)
wks.Range("A1:A3").HorizontalAlignment = xlLeft

wks.Range("A5:K5").Font.Bold = True
wks.Range("A5:K5").Font.Size = 10
wks.Range("A5:K5").Font.Name = "Arial"
wks.Range("A5:K5").Interior.ColorIndex = 15
wks.Range("A5:K5").WrapText = True
wks.Range("A5:K5").HorizontalAlignment = xlCenter
wks.Range("A5:A60").HorizontalAlignment = xlCenter
wks.Range("E5:E60").HorizontalAlignment = xlCenter
wks.Range("H5:K60").HorizontalAlignment = xlCenter
wks.Range("B57:K57").Font.Bold = True
wks.Rows(5).RowHeight = 35
'wks.Range("B4:B55").HorizontalAlignment = xlLeft
'wks.Range("D:E").HorizontalAlignment = xlCenter
'rank
wks.Range("A5:A60").ColumnWidth = 15
'airline
wks.Range("B5:B60").ColumnWidth = 30
'sales
wks.Range("C5:E60").ColumnWidth = 13
'ytd_current
wks.Range("F5:F60").ColumnWidth = 12
'ytd_previous, ytd_variance
wks.Range("G5:I60").ColumnWidth = 13

wks.Range("A1").Value = "Test1"
wks.Range("A2").Value = "Test2"
wks.Range("A3").Value = "Test3"
wks.Range("A5").Value = "RANK"
wks.Range("B5").Value = "DESC"
wks.Range("C5").Value = "INV CURRENT"
wks.Range("D5").Value = "INV PREVIOUS"
wks.Range("E5").Value = "INV VARIANCE"
wks.Range("F5").Value = "YTD CURRENT"
wks.Range("G5").Value = "YTD PREVIOUS"
wks.Range("H5").Value = "YTD VARIANCE"
wks.Range("I5").Value = "MARKET SHARE CURRENT"
wks.Range("J5").Value = "MARKET SHARE PREVIOUS"
wks.Range("K5").Value = "SHARE VS LY"

wks.Range("A1").NumberFormat = "mmm-yy"
wks.Range("C6:D60").NumberFormat = "#,##0_);-#,##0"
wks.Range("E6:E60").NumberFormat = "#,##0.00%_);-#,##0.00%"
wks.Range("F6:G60").NumberFormat = "#,##0_);-#,##0"
wks.Range("E6:E60").NumberFormat = "#,##0%_);-#,##0%"
wks.Range("H6:H60").NumberFormat = "#,##0%_);-#,##0%"
wks.Range("I6:J60").NumberFormat = "#,##0.0%_);-#,##0.0%"
wks.Range("K6:K60").NumberFormat = "#,##0%_);-#,##0%"

wks.Range("A6").CopyFromRecordset rs


'insert columns
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
wks.Range("C:C").ColumnWidth = 0.5

Columns("G:G").Select
Selection.Insert Shift:=xlToRight
wks.Range("G:G").ColumnWidth = 0.5

Columns("K:K").Select
Selection.Insert Shift:=xlToRight
wks.Range("K:K").ColumnWidth = 0.5

Rows(57).EntireRow.Insert
Range("B58:N58").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone

'delete 51 & 52 number description from RANK field in Excel
wks.Range("A56:A58").Value = ""

wks.Name = rsID("id").Value
rsID.MoveNext
Next x
Loop

rs.Close
rsID.Close

Set rs = Nothing
Set rsID = Nothing
Set qDef = Nothing
Set wkb = Nothing
Set wks = Nothing
Set xlApp = Nothing
Set db = Nothing


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,253
Default Repost! Excel multiple worksheet populate from recordset

B.
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Populate central worksheet template from multiple worksheets wcurtis Excel Discussion (Misc queries) 0 December 24th 08 10:10 PM
Lookup list from different worksheet & auto-populate multiple cell tomhelle Excel Discussion (Misc queries) 0 November 5th 08 05:37 PM
getting multiple data to populate another worksheet nick parker Excel Worksheet Functions 0 January 11th 05 02:59 PM
Help! Excel multiple worksheet populate from recordset B[_3_] Excel Programming 1 November 5th 04 09:59 AM
How to populate a multi-column activeX listbox on a spreadsheet with an ADO recordset quartz Excel Programming 1 May 3rd 04 10:13 PM


All times are GMT +1. The time now is 09:44 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"