import the data across multiple sheets when more than 256 columns

[arbo80]

Hi all,

I have posted here before and most of the time, I have gotten the help that I needed. We have the following macro that creates a report. The macro:
1) Open a template (Excel file) and copy the same (4) columns from one sheet named “Sheet 1” to another one named “Table 1” multiple times.
2) For each set of columns (above), associate one record from a field (Desk) in a table ( Access database)
3) Then, populate the report.
4) Finally repeat steps (1-3) for 3 other tables in the same template. Thus, at the end, the report should have 5 sheets: “Sheet1”, “Table 1”, “Table 2”, “Table 3”, “Table 4”

However, my macro returns more than 256 columns per sheet because the total number of columns is equal to the number of records in the field in MS Access times the 4 columns in “Sheet 1”. It works fine in Excel 2007 but obviously doesn’t work in Excel 2003 because of the limitations. I would like the macro to place the first 254 fields/columns on one sheet in the workbook and the remaining fields (beginning with the 255th field) on a second sheet in the workbook…The report would look like this: “Sheet1”, “Table 1”, “Table 1b”, “Table 2”, “Table 2b”, etc.

However, I have tried to come out with the proper code but I’m very limited with excel. In addition, this macro was designed by somebody else who doesn’t work at my company anymore. Your help will be greatly appreciated.

Thanks very much,

B.

The code below is for only one of the tables:

Dim db As Database
Dim wrkJet As Workspace
Dim datCurWeek As Date
Dim lngRow As Long
Dim J As Integer

Sub PopulateReport()
Dim strOutputFile As String
Dim strOutputFileName As String
Dim I As Integer
Dim intYear As Integer
Dim intCurYear

Call DBOpen
strOutputFile = Range("rngOutputFile")

FileCopy "C:\Report Template.xlsx", strOutputFile
strOutputFileName = Right(strOutputFile, _
Len(strOutputFile) - InStrRev(strOutputFile, "\"))
Workbooks.Open strOutputFile
Workbooks(strOutputFileName).Activate

' lngRow = 3
' intYear = Year(Now)
' intCurYear = Year(Now)
' datCurWeek = Now - Weekday(Now) + 2
' While intYear = intCurYear
' Range("A" & lngRow) = datCurWeek

Call GetTable1Data
Call GetTable2Data
Call GetTable3Data
Call GetTable4Data

' datCurWeek = datCurWeek - 7
' intCurYear = Year(datCurWeek)
' lngRow = lngRow + 1
' Wend
' Set objExcel = Nothing
Workbooks(strOutputFileName).Sheets("Sheet1").Visible = False
End Sub

Sub DBOpen()
Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
Set db = wrkJet.OpenDatabase("C:\MyAccess.mdb", False)
End Sub

Sub GetTable1Data()
Dim strSQL As String
Dim rs As Recordset
Dim rsDesk As Recordset
Dim I As Integer
Dim intYear As Integer
Dim intCurYear

Sheets("Sheet1").Select
Range("AA:AD").Select
Selection.Copy

Sheets("Table1").Select
lngRow = 3
intYear = Year(Now)
' intYear = 2008

intCurYear = Year(Now)
datCurWeek = Now - Weekday(Now) + 2

strSQL = "SELECT DISTINCT Table1.Desk FROM Table1"
Set rsDesk = db.OpenRecordset(strSQL)
rsDesk.MoveFirst
I = 2
While Not rsDesk.EOF
Sheets("Table1").Cells(1, I).Select
Sheets("Table1").Paste
Sheets("Table1").Cells(1, I) = rsDesk(0)
I = I + 4
rsDesk.MoveNext
Wend

While intYear = intCurYear
Range("A" & lngRow) = Format(datCurWeek, "mm/dd/yyyy")
rsDesk.MoveFirst
I = 2
While Not rsDesk.EOF
' Sheets("Table1").Cells(1, I).Select
' Sheets("Table1").Paste
'
' Sheets("Table1").Cells(1, I) = rsDesk(0)

strSQL = "SELECT Count(Table1.TradeID) AS CountOfTradeID " & _
"FROM Table1 " & _
"WHERE ((Table1.AmendDate >= #" & Format(datCurWeek, "mm/dd/yyyy") & "#) And (Table1.AmendDate < #" & _
Format((datCurWeek + 7), "mm/dd/yyyy") & "#) And (Table1.Status = 'Ver') AND " & _
"(Table1.ChangeType='Cancelled') And (Table1.Desk = '" & rsDesk(0) & "'))"
Set rs = db.OpenRecordset(strSQL)
If Not (rs.BOF And rs.EOF) Then Sheets("Table1").Cells(lngRow, I) = rs(0)


strSQL = "SELECT Count(Table1.TradeID) AS CountOfTradeID " & _
"FROM Table1 " & _
"WHERE ((Table1.AmendDate >= #" & Format(datCurWeek, "mm/dd/yyyy") & "#) And (Table1.AmendDate < #" & _
Format((datCurWeek + 7), "mm/dd/yyyy") & "#) And (Table1.Status = 'Ver') And (Table1.Desk = '" & rsDesk(0) & "'))"
Set rs = db.OpenRecordset(strSQL)
If Not (rs.BOF And rs.EOF) Then Sheets("Table1").Cells(lngRow, I + 1) = rs(0)

strSQL = "SELECT Count(Table1.TradeID) AS CountOfTradeID " & _
"FROM Table1 " & _
"WHERE ((Table1.AmendDate>=#" & Format(datCurWeek, "mm/dd/yyyy") & "#) AND (Table1.AmendDate<#" & _
Format((datCurWeek + 7), "mm/dd/yyyy") & "#) AND (Table1.Status='Ver') AND ((Table1.ChangeType)='Customer') And ((Table1.Desk) = '" & _
rsDesk(0) & "'))"
Set rs = db.OpenRecordset(strSQL)
If Not (rs.BOF And rs.EOF) Then Sheets("Table1").Cells(lngRow, I + 2) = rs(0)

strSQL = "SELECT Count(Table1.TradeID) AS CountOfTradeID " & _
"FROM Table1 " & _
"WHERE ((Table1.AmendDate>=#" & Format(datCurWeek, "mm/dd/yyyy") & "#) AND (Table1.AmendDate<#" & _
Format((datCurWeek + 7), "mm/dd/yyyy") & "#) AND (Table1.Status='Ver') AND ((Table1.ChangeType='EffDate') OR (Table1.ChangeType='StartDate')) And (Table1.Desk = '" & _
rsDesk(0) & "'))"
Set rs = db.OpenRecordset(strSQL)
If Not (rs.BOF And rs.EOF) Then Sheets("Table1").Cells(lngRow, I + 3) = rs(0)
rsDesk.MoveNext
For J = 0 To 3
If Sheets("Table1").Cells(lngRow, I + J) > 0 Then
Sheets("Table1").Cells(lngRow, I + J).Interior.ColorIndex = 3
Sheets("Table1").Cells(lngRow, I + J).Interior.Pattern = xlSolid
End If
Next J
I = I + 4
Wend
datCurWeek = datCurWeek - 7
intCurYear = Year(datCurWeek)
lngRow = lngRow + 1

Wend
End Sub

 

[SkipVought]

hi,

If the data is in MS Access, what is the purpose of...

1. IMPORTING the data and
2. importing the data IN THIS MANNER (columnwise)

Please answer both questions.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[arbo80]

Hi Skip,

Below are my answers:

1. We are importing the data from MS Access to create an Excel report for the legal team.

2. The legal group wants to see the data in a specific format which is why the columns have to be in that manner.

Like I said above, everything is fine if they use Excel 2007 but my IT team here doesn't want to install Excel 2003 on their machine. Please let me know if you need further clarification.

Thanks,
B.

 

[SkipVought]

B,

Very clumsy, IMNSHO.

I'm not going to wade thru your code. Have you debugged your code to see exactly what is happening?" Where is your code failing to do what you need it to do?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[arbo80]

Skip,

My code is working fine when the number of columns is less than 256. The problem is the limits on the number of columns in Excel 2003. I just want to be able to copy the extra columns (255+) to a new sheet. Below is where the code fails:

While Not rsDesk.EOF
Sheets("Table1").Cells(1, I).Select
Sheets("Table1").Paste
Sheets("Table1").Cells(1, I) = rsDesk(0)
I = I + 4
rsDesk.MoveNext
Wend

Thanks,
B.

 

[SkipVought]

How about something like this...

    Dim ws As Worksheet, I

    I = 0
    While Not rsDesk.EOF
        If I Mod 255 = 0 Then
            Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
            I = 0
        End If[b]
    'if PASTE, where is COPY?
    '    ws.Cells(1, I).PasteSpecial xlPasteValues[/b]
        ws.Cells(1, I) = rsDesk(0)
        I = I + 4
        rsDesk.MoveNext
    Wend
    Set ws = Nothing

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]