Loop this code!

[voskouee]

i have th following code that runs for one of my tables... the thing is that i need to get the name of the table every time and loop the code. all the tables are listed in one table

so i have

RFGWORKING (it lists all my working tables)

the code for the one table is...

'Table RN00144GE3RFG
Set objRST = Application.CurrentDb.OpenRecordset("SELECT * FROM RN00144GE3RFG;")
Set xlSheet = xlWorkbook.Sheets(1)
With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = "JO-RN00144GE3"
i = 1
'create the column headings in cells
With objRST
For Each f In .Fields
With xlSheet
.Cells(1, i).Value = f.Name
i = i + 1
End With
Next

End With

'Change the font to bold for the header row
xlSheet.Columns.AutoFit
xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, objRST.Fields.Count)).Font.Bold = True

Sheets("JO-RN00144GE3").Select
With .Range("A1:T1").Interior
.ColorIndex = 15
.Pattern = xlSolid
lngRows = Range("a2").CurrentRegion.Rows.Count
lngCols = Range("a2").CurrentRegion.Columns.Count
Cells(lngRows + 3, lngCols - 3).Formula = "=SUM(Q1:Q" & lngRows & ")"
Cells(lngRows + 3, lngCols - 4).Formula = "=SUM(Q1:Q" & lngRows & ")"
'Add /fp to debit
ActiveWindow.SmallScroll ToRight:=3
Columns("Q:Q").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="0"
Selection.Replace What:="0", Replacement:="\fp", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
Selection.AutoFilter
'Remove the 0 values
Columns("P").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="0"
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
Selection.AutoFilter
Columns("P:Q").Select
Selection.NumberFormat = "#,##0.000"

End With

End With


Any suggestions how to make it work for all?

 

[Bodisathva]

establish a recordset containing the tableNames, cycle through it, and replace the static refrences to the table name with the field from the recordset (and don't forget to move to the next record at the end of the loop):

Set rec = currentDB.OpenRecordset("SELECT * FROM tableList")
While Not(rec.EOF)
     Set objRST = CurrentDb.OpenRecordset("SELECT * FROM " & rec!tableName")
      blah...
      blah...
      blah...etc.
      rec.moveNext
Wend

 

[Bat17]

you will need to add the names as variables

Dim strTable As sting
Dim strSheetName As sting

strTable = "RN00144GE3RFG"
strSheetName = "JO-" & Left(strTable, 10)

Set objRST = Application.CurrentDb.OpenRecordset("SELECT * FROM " & strTable & ";")
Set xlSheet = xlWorkbook.Sheets(1)
With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = "strSheetName"
i = 1

Will only work like this if you have consistant naming though

Peter

 

[voskouee]

i did the changes.. it loops to create the sheets but it doesnt copy the records from the recordsets.. u think i have a syntax error?

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Add
xlWorkbook.Worksheets("Sheet1").Delete
xlWorkbook.Worksheets("Sheet2").Delete
xlApp.DisplayAlerts = False

'Create Sheets of Working Tables
Set rec = Application.CurrentDb.OpenRecordset("SELECT * FROM RFGWorking;")
While Not (rec.EOF)
Set objRST = CurrentDb.OpenRecordset("SELECT * FROM " & rec!SOBP & " ;")
Set xlSheet = xlWorkbook.Sheets.Add
xlSheet.Activate

With xlSheet
xlSheet.Range("A2").CopyFromRecordset objRST
.Name = "" & rec!SOBP & ""
i = 1
'create the column headings in cells
With objRST
For Each f In .Fields
With xlSheet
.Cells(1, i).Value = f.Name
i = i + 1
End With
Next

End With

'Change the font to bold for the header row
xlSheet.Columns.AutoFit
xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, objRST.Fields.Count)).Font.Bold = True

With .Range("A1:T1").Interior
.ColorIndex = 15
.Pattern = xlSolid
lngRows = Range("a2").CurrentRegion.Rows.Count
lngCols = Range("a2").CurrentRegion.Columns.Count
Cells(lngRows + 3, lngCols - 3).Formula = "=SUM(Q1:Q" & lngRows & ")"
Cells(lngRows + 3, lngCols - 4).Formula = "=SUM(Q1:Q" & lngRows & ")"

'Add /fp to debit
ActiveWindow.SmallScroll ToRight:=3
Columns("Q:Q").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="0"
Selection.Replace What:="0", Replacement:="\fp", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
Selection.AutoFilter

'Remove the 0 values
Columns("P").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="0"
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
Selection.AutoFilter
Columns("P:Q").Select
Selection.NumberFormat = "#,##0.000"

End With

End With

rec.MoveNext
Wend

 

[Bodisathva]

there's an extra End With...FYI, I've always found nested With statements to be somewhat unpredictable.

You should also save the sheet before you try to add another.

 

[voskouee]

i counted the with and the end and are correct? if it was one more end with it would give me an error anyway....

my syntax on the recordeset is ok?
how do i save the worksheet?

 

[Bodisathva]

ok, found the other with (hint: use the code tags...formatting and indentation are essential to debugging code)

before moving to the next record in the recordset, issue the save command for the Workbook...the next iteration redefines the worksheet.

 

[Bat17]

.Name = "" & rec!SOBP & "" and looks like unneeded quotes
.Name = rec!SOBP

Peter