HELP!!! Inserting cell values

Set wsp = DBEngine.Workspaces(0) Set db = wsp.OpenDatabase("n:\PPORevenue.mdb") db.QueryTimeout = 15000 Set rge = Worksheets("RTF").Range("a7") Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site") rec.MoveLast intRows = rec.RecordCount rec.MoveFirst intFields = rec.Fields.Count 'pastes field names For intCount1 = 0 To intFields - 1 'do as many times as there are fields rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name Next intCount1 Range("M7").Select ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSSAVINGS%" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSTDREDUCT" 'pastes field values For intcount2 = 0 To intRows - 1 'do this as many times as there are rows For intcount3 = 0 To intFields - 1 'do this as many times as there are fields rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value Next intcount3 rec.MoveNext Next intcount2 rec.Close 'Format width of columns and add border around titles Range("a7", "z60000").Select 'starting and ending cell in () Selection.Columns.AutoFit 'With Worksheets("RTF") '.Range(.Cells(7, 1), .Cells(7, 7)).Borders.Weight = xlThin 'End With db.Close End Sub

Try the following:
Range("M7").Select
ActiveCell.EntireColumn.Insert
ActiveCell.Formula = "=RC[n]-RC[n]"

Where the first n represents the number of columns from your activecell you find the value 'stdallow' and the second n represents the number of columns from your activecell you find the value 'ppoallow'. For example, after you insert a column your value for 'stdallow' is in
column L, then the value for n=-1.

You can then use the same syntax and logic for the rest of your code.

Does this help you?
Barrie

Further to my code

The code above is for PPOSAVINGS.

Yes - that does help me a lot - Thanks so much! One more question - how do I get it to add all the data instead of just that first cell? What kind of loop should I use?

Actually, the easiest way would be to copy the formula down to the end of your data. If you declare a variable and assign it the value of your last row, your syntax would be (assuming your variable is named LRow):
ActiveCell.Copy
ActiveCell.Range("A1:A" & LRow - ActiveCell.Row + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Barrie

Set wsp = DBEngine.Workspaces(0) Set db = wsp.OpenDatabase("n:\PPORevenue.mdb") db.QueryTimeout = 15000 Set rge = Worksheets("RTF").Range("a7") Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site") rec.MoveLast intRows = rec.RecordCount rec.MoveFirst intFields = rec.Fields.Count 'pastes field names For intCount1 = 0 To intFields - 1 'do as many times as there are fields rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name Next intCount1 Range("M7").Select ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSSAVINGS%" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSTDREDUCT" 'pastes field values For intcount2 = 0 To intRows - 1 'do this as many times as there are rows For intcount3 = 0 To intFields - 1 'do this as many times as there are fields rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value Next intcount3 rec.MoveNext Next intcount2 rec.Close 'Format width of columns and add border around titles Range("a7", "z60000").Select 'starting and ending cell in () Selection.Columns.AutoFit

Is there a way to do it without having to know the last row? This is going to be run every week, and the number of rows will vary... I would have to go in and change this each time? Or is there an easier way? Thanks for all your help!

Set wsp = DBEngine.Workspaces(0) Set db = wsp.OpenDatabase("n:\PPORevenue.mdb") db.QueryTimeout = 15000 Set rge = Worksheets("RTF").Range("a7") Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site") rec.MoveLast intRows = rec.RecordCount rec.MoveFirst intFields = rec.Fields.Count 'pastes field names For intCount1 = 0 To intFields - 1 'do as many times as there are fields rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name Next intCount1 Range("M7").Select ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSSAVINGS%" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSTDREDUCT" 'pastes field values For intcount2 = 0 To intRows - 1 'do this as many times as there are rows For intcount3 = 0 To intFields - 1 'do this as many times as there are fields rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value Next intcount3 rec.MoveNext Next intcount2 rec.Close 'Format width of columns and add border around titles Range("a7", "z60000").Select 'starting and ending cell in () Selection.Columns.AutoFit

An easy to identify the last row would be to select a column where you know it has data in each row (this is important, you can't have any blanks). Assuming column C meets this criteria, then use:

LRow = Range("C1").End(xlDown).Row

The code "End(xlDown)" is the same as END+ARROW DOWN.

Barrie Is there a way to do it without having to know the last row? This is going to be run every week, and the number of rows will vary... I would have to go in and change this each time? Or is there an easier way? Thanks for all your help! Set wsp = DBEngine.Workspaces(0) Set db = wsp.OpenDatabase("n:\PPORevenue.mdb") db.QueryTimeout = 15000 Set rge = Worksheets("RTF").Range("a7") Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site") rec.MoveLast intRows = rec.RecordCount rec.MoveFirst intFields = rec.Fields.Count 'pastes field names For intCount1 = 0 To intFields - 1 'do as many times as there are fields rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name Next intCount1 Range("M7").Select ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSSAVINGS%" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSTDREDUCT" 'pastes field values For intcount2 = 0 To intRows - 1 'do this as many times as there are rows For intcount3 = 0 To intFields - 1 'do this as many times as there are fields rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value Next intcount3 rec.MoveNext Next intcount2 rec.Close 'Format width of columns and add border around titles Range("a7", "z60000").Select 'starting and ending cell in () Selection.Columns.AutoFit

How did you post your original message? Selecting "post" does nothing for me! (my question below)

I am trying to use an Excel macro to open a .csv spreadsheet and change the page orientation on it. I've used the "record macro" option to come up with the following code, but it does not change the the pagesetup on the spreadsheet I just opened. For some reason, it changes the orientation on the spreadsheet that the macro is saved in, but goes on to add titles and format in the file I want it to? Any idea what's going on? Here's my code:

Workbooks.Open FileName:="\\FIL-MOR1\SYS\revenue\monthend\monthresult.csv"
With ActiveSheet.PageSetup
.PrintTitleRows = "$5:$7"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.CenterFooter = "Page &P of &N"
.Orientation = xlLandscape
End With
Range("C:D,K:K").Select
Range("K1").Activate
Selection.NumberFormat = "0.0%"
Range("E:F,H:I").Select
Range("H1").Activate
Selection.NumberFormat = "#,##0"
Range("G:G,J:J").Select
Range("J1").Activate
Selection.NumberFormat = "0.00"
Columns("C:K").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Rows("6:6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("A4:K107").Select
Selection.Columns.AutoFit
Range("B1").Select
ActiveWorkbook.SaveAs FileName:="F:\revenue\monthend\monthresult.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Thank you very much!!!

Sorry - ignore this

Workbooks.Open FileName:="\\FIL-MOR1\SYS\revenue\monthend\monthresult.csv" With ActiveSheet.PageSetup .PrintTitleRows = "$5:$7" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .CenterFooter = "Page &P of &N" .Orientation = xlLandscape End With Range("C:D,K:K").Select Range("K1").Activate Selection.NumberFormat = "0.0%" Range("E:F,H:I").Select Range("H1").Activate Selection.NumberFormat = "#,##0" Range("G:G,J:J").Select Range("J1").Activate Selection.NumberFormat = "0.00" Columns("C:K").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .ShrinkToFit = False .MergeCells = False End With Rows("6:6").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Range("A4:K107").Select Selection.Columns.AutoFit Range("B1").Select ActiveWorkbook.SaveAs FileName:="F:\revenue\monthend\monthresult.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Thank you very much!!!

Here is the code I run - I keep getting an application or object defined error... any ideas?

LRow = Range("B1").End(xlDown).Row

Range("I8").Select
ActiveCell.Formula = "=RC[-1]-RC[3]"
ActiveCell.Copy
ActiveCell.Range("I1:I" & LRow - ActiveCell.Row + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False An easy to identify the last row would be to select a column where you know it has data in each row (this is important, you can't have any blanks). Assuming column C meets this criteria, then use: LRow = Range("C1").End(xlDown).Row The code "End(xlDown)" is the same as END+ARROW DOWN. Barrie : Is there a way to do it without having to know the last row? This is going to be run every week, and the number of rows will vary... I would have to go in and change this each time? Or is there an easier way? Thanks for all your help! : Set wsp = DBEngine.Workspaces(0) Set db = wsp.OpenDatabase("n:\PPORevenue.mdb") db.QueryTimeout = 15000 Set rge = Worksheets("RTF").Range("a7") Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site") rec.MoveLast intRows = rec.RecordCount rec.MoveFirst intFields = rec.Fields.Count 'pastes field names For intCount1 = 0 To intFields - 1 'do as many times as there are fields rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name Next intCount1 Range("M7").Select ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSSAVINGS%" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSTDREDUCT" 'pastes field values For intcount2 = 0 To intRows - 1 'do this as many times as there are rows For intcount3 = 0 To intFields - 1 'do this as many times as there are fields rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value Next intcount3 rec.MoveNext Next intcount2 rec.Close 'Format width of columns and add border around titles Range("a7", "z60000").Select 'starting and ending cell in () Selection.Columns.AutoFit

Hi CJ

Column B must empty so the xldown is returning row 65536 then you try to add 1 and there is not that many rows. You can do this all in one step like below:

Range("I1:I" & Range("B65536").End(xlUp).Row).Formula = "=RC[-1]-RC[3]"

Of course you need to use the row number from a column with data.

Dave

OzGrid Business Applications

Hi Dave - thanks for the help... I am still having problems - the formula doesn't create any value at all - Can you see what I am doing wrong???

Private Sub cmdImport_Click()
Dim rec As Recordset
Dim rge As Range
Dim intRows As Integer
Dim intFields As Integer
Dim strSelect As String
Dim strConn As String
Dim db As Database
Dim wsp As Workspace
Dim stDocName1 As String

LRow = Range("B1").End(xlDown).Row

Call Clear_DataRange

Set wsp = DBEngine.Workspaces(0)
Set db = wsp.OpenDatabase("n:\PPORevenue.mdb")
db.QueryTimeout = 15000

Set rge = Worksheets("RTF").Range("a7")

Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site")
rec.MoveLast
intRows = rec.RecordCount
rec.MoveFirst
intFields = rec.Fields.Count

'pastes field names
For intCount1 = 0 To intFields - 1 'do as many times as there are fields
rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name
Next intCount1

'pastes field values
For intcount2 = 0 To intRows - 1 'do this as many times as there are rows
For intcount3 = 0 To intFields - 1 'do this as many times as there are fields
rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value
Next intcount3
rec.MoveNext
Next intcount2

'Insert blank columns

Range("I7").Select
ActiveCell.EntireColumn.Insert
ActiveCell.Value = "PPOSAVINGS%"
ActiveCell.EntireColumn.Insert
ActiveCell.Value = "PPOSAVINGS"
ActiveCell.EntireColumn.Insert
ActiveCell.Value = "PPOSTDREDUCT"
Range("B1").Select
ActiveCell.EntireColumn.Insert

'Insert values into columns

Range("J8").Select
ActiveCell.Range("J1:J" & Range("B65536").End(xlUp).Row).Formula = "=RC[-1]-RC[3]"
ActiveCell.Copy
ActiveCell.Range("J1:J" & LRow - ActiveCell.Row + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
rec.Close
'Format width of columns and add border around titles
Range("a7", "z60000").Select 'starting and ending cell in ()
Selection.Columns.AutoFit

'With Worksheets("RTF")
'.Range(.Cells(7, 1), .Cells(7, 7)).Borders.Weight = xlThin
'End With

db.Close

End Sub

If you manually go to your worksheet, cell B1, and press END and then ARROW DOWN, where do you end up on your worksheet (what cell)?

Barrie Here is the code I run - I keep getting an application or object defined error... any ideas? LRow = Range("B1").End(xlDown).Row Set wsp = DBEngine.Workspaces(0) Set db = wsp.OpenDatabase("n:\PPORevenue.mdb") db.QueryTimeout = 15000 Set rge = Worksheets("RTF").Range("a7") Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site") rec.MoveLast intRows = rec.RecordCount rec.MoveFirst intFields = rec.Fields.Count 'pastes field names For intCount1 = 0 To intFields - 1 'do as many times as there are fields rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name Next intCount1 Range("M7").Select ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSSAVINGS%" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSTDREDUCT" 'pastes field values For intcount2 = 0 To intRows - 1 'do this as many times as there are rows For intcount3 = 0 To intFields - 1 'do this as many times as there are fields rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value Next intcount3 rec.MoveNext Next intcount2 rec.Close 'Format width of columns and add border around titles Range("a7", "z60000").Select 'starting and ending cell in () Selection.Columns.AutoFit

I tried using an example that Dave sent, but now, it won't insert any formula into the cell... Here is the code - can you see what I am doing wrong???

Private Sub cmdImport_Click()
Dim rec As Recordset
Dim rge As Range
Dim intRows As Integer
Dim intFields As Integer
Dim strSelect As String
Dim strConn As String
Dim db As Database
Dim wsp As Workspace
Dim stDocName1 As String

Call Clear_DataRange

Set wsp = DBEngine.Workspaces(0)
Set db = wsp.OpenDatabase("n:\PPORevenue.mdb")
db.QueryTimeout = 15000

Set rge = Worksheets("RTF").Range("a7")

Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site")
rec.MoveLast
intRows = rec.RecordCount
rec.MoveFirst
intFields = rec.Fields.Count

'pastes field names
For intCount1 = 0 To intFields - 1 'do as many times as there are fields
rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name
Next intCount1

'pastes field values
For intcount2 = 0 To intRows - 1 'do this as many times as there are rows
For intcount3 = 0 To intFields - 1 'do this as many times as there are fields
rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value
Next intcount3
rec.MoveNext
Next intcount2

'Insert blank columns

Range("I7").Select
ActiveCell.EntireColumn.Insert
ActiveCell.Value = "PPOSAVINGS%"
ActiveCell.EntireColumn.Insert
ActiveCell.Value = "PPOSAVINGS"
ActiveCell.EntireColumn.Insert
ActiveCell.Value = "PPOSTDREDUCT"
Range("B1").Select
ActiveCell.EntireColumn.Insert

'Insert values into columns

Range("J8").Select
ActiveCell.Range("J1:J" & Range("B65536").End(xlUp).Row).Formula = "=RC[-1]-RC[3]"
'ActiveCell.Copy
'ActiveCell.Range("J1:J" & LRow - ActiveCell.Row + 1).Select
'ActiveSheet.Paste
'Application.CutCopyMode = False
rec.Close
'Format width of columns and add border around titles
Range("a7", "z60000").Select 'starting and ending cell in ()
Selection.Columns.AutoFit

'With Worksheets("RTF")
'.Range(.Cells(7, 1), .Cells(7, 7)).Borders.Weight = xlThin
'End With

db.Close

End Sub

The problem lies in
ActiveCell.Range("J1:J" & Range("B65536").End(xlUp).Row).Formula = "=RC[-1]-RC[3]"

From what I can see in your code, column J will be blank (you just inserted this column). Try using the variable I described using this syntax,
LRow = Range("I7").End(xlDown).Row
Put this code before your code
Range("I7").Select
and then change your code to
ActiveCell.Range("J1:J" & LRow).Formula = "=RC[-1]-RC[3]"

Let me know if this works for you.

Barrie I tried using an example that Dave sent, but now, it won't insert any formula into the cell... Here is the code - can you see what I am doing wrong??? Private Sub cmdImport_Click() Dim stDocName1 As String Call Clear_DataRange Set wsp = DBEngine.Workspaces(0) Set db = wsp.OpenDatabase("n:\PPORevenue.mdb") db.QueryTimeout = 15000 Set rge = Worksheets("RTF").Range("a7") Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site") rec.MoveLast intRows = rec.RecordCount rec.MoveFirst intFields = rec.Fields.Count 'pastes field names For intCount1 = 0 To intFields - 1 'do as many times as there are fields rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name Next intCount1 'pastes field values For intcount2 = 0 To intRows - 1 'do this as many times as there are rows For intcount3 = 0 To intFields - 1 'do this as many times as there are fields rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value Next intcount3 rec.MoveNext Next intcount2 'Insert blank columns Range("I7").Select ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS%" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSTDREDUCT" Range("B1").Select ActiveCell.EntireColumn.Insert 'Insert values into columns Range("J8").Select ActiveCell.Range("J1:J" & Range("B65536").End(xlUp).Row).Formula = "=RC[-1]-RC[3]" 'ActiveCell.Copy 'ActiveCell.Range("J1:J" & LRow - ActiveCell.Row + 1).Select 'ActiveSheet.Paste 'Application.CutCopyMode = False rec.Close 'Format width of columns and add border around titles Range("a7", "z60000").Select 'starting and ending cell in () Selection.Columns.AutoFit 'With Worksheets("RTF") '.Range(.Cells(7, 1), .Cells(7, 7)).Borders.Weight = xlThin 'End With db.Close End Sub

Private Sub cmdImport_Click() Dim stDocName1 As String LRow = Range("B1").End(xlDown).Row Call Clear_DataRange Set wsp = DBEngine.Workspaces(0) Set db = wsp.OpenDatabase("n:\PPORevenue.mdb") db.QueryTimeout = 15000 Set rge = Worksheets("RTF").Range("a7") Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site") rec.MoveLast intRows = rec.RecordCount rec.MoveFirst intFields = rec.Fields.Count 'pastes field names For intCount1 = 0 To intFields - 1 'do as many times as there are fields rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name Next intCount1 'pastes field values For intcount2 = 0 To intRows - 1 'do this as many times as there are rows For intcount3 = 0 To intFields - 1 'do this as many times as there are fields rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value Next intcount3 rec.MoveNext Next intcount2 'Insert blank columns Range("I7").Select ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS%" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSAVINGS" ActiveCell.EntireColumn.Insert ActiveCell.Value = "PPOSTDREDUCT" Range("B1").Select ActiveCell.EntireColumn.Insert 'Insert values into columns Range("J8").Select ActiveCell.Range("J1:J" & Range("B65536").End(xlUp).Row).Formula = "=RC[-1]-RC[3]" ActiveCell.Copy ActiveCell.Range("J1:J" & LRow - ActiveCell.Row + 1).Select ActiveSheet.Paste Application.CutCopyMode = False rec.Close 'Format width of columns and add border around titles Range("a7", "z60000").Select 'starting and ending cell in () Selection.Columns.AutoFit 'With Worksheets("RTF") '.Range(.Cells(7, 1), .Cells(7, 7)).Borders.Weight = xlThin 'End With db.Close End Sub

Hi Cj

Try this

Private Sub cmdImport_Click()
Dim rec As Recordset
Dim rge As Range
Dim intRows As Integer
Dim intFields As Integer
Dim strSelect As String
Dim strConn As String
Dim db As Database
Dim wsp As Workspace
Dim stDocName1 As String
Dim lRow As Long

lRow = Range("B1").End(xlDown).Row

Call Clear_DataRange

Set wsp = DBEngine.Workspaces(0)
Set db = wsp.OpenDatabase("n:\PPORevenue.mdb")
db.QueryTimeout = 15000

Set rge = Worksheets("RTF").Range("a7")

Set rec = db.OpenRecordset("Monthly All PPO Results by Processing Site")
rec.MoveLast
intRows = rec.RecordCount
rec.MoveFirst
intFields = rec.Fields.Count

'pastes field names
For intCount1 = 0 To intFields - 1 'do as many times as there are fields
rge.Cells(1, intCount1 + 1).Value = rec.Fields(intCount1).Name
Next intCount1

'pastes field values
For intcount2 = 0 To intRows - 1 'do this as many times as there are rows
For intcount3 = 0 To intFields - 1 'do this as many times as there are fields
rge.Cells(intcount2 + 2, intcount3 + 1).Value = rec.Fields(intcount3).Value
Next intcount3
rec.MoveNext
Next intcount2

'Insert blank columns

Columns("I:K").EntireColumn.Insert
[K7] = "PPOSAVINGS%"
[J7] = "PPOSAVINGS"
[I7] = "PPOSTDREDUCT"

Range("B1").EntireColumn.Insert

'Insert values into columns

Range("J8:J" & Range("B65536").End(xlUp).Row).Formula = "=RC[-1]-RC[3]"

rec.Close
'Format width of columns and add border around titles
Range("A:Z").Columns.AutoFit 'starting and ending cell in ()

'With Worksheets("RTF")
'.Range(.Cells(7, 1), .Cells(7, 7)).Borders.Weight = xlThin
'End With

db.Close
End sub

Dave

OzGrid Business Applications

HI Dave, when I run this code, it inserts the formula in J1 through J8.... instead of starting at J8 and going down...