Inserting Excel Rows via VBScript

[griffinmt]

I am going to give this one more try.
I am having some difficulty with determining the line of code that will allow me to insert a new row above the currently selected cell. The code created when you record a macro and do this manually will not work when transported to VBScript.

Here is a snippet of code, with the offending line bolded in red.

Set oEx = GetObject("","Excel.Application")
oEx.Visible = true
oEx.Workbooks.open "C:\test.xls"
Set oWS = oEx.ActiveWorkbook.Sheets("Sheet1")
oWS.Activate
Toprow = 1
Bottomrow = 8

For i = Toprow to Bottomrow
	oWS.Range("a1").Offset(i,0).Select
	If oWS.Range(&quot;a1&quot;).Offset(i+1,0) <> &quot;&quot; Then

oWS.Selection.EntireRow.Insert

        oWS.Range("a1").Offset(i,0).Select
	End If
	oWS.Range("a1").Offset(i,0) = "Stuff" & i
	oWS.Range("a1").Offset(i,1) = "More Stuff" & i
Next

Try this on a simple sheet with any data in cell A1 and in A5 and the rest empty.

Desperately wanting an approach!!!

 

[caf]

Hi

This code should work for you

   Dim oEX  'As Excel.Application
   Dim oWB  'As Excel.Workbook
   Dim oWS  'As Excel.Worksheet

   Dim lTopRow       'As Long
   Dim lBottomRow    'As Long
   Dim iIndex        'As Integer

   Set oEX = CreateObject("Excel.Application")
   Set oWB = oEX.Workbooks.Open("d:\book3.xls")
   Set oWS = oWB.Sheets("Sheet1")

   oEX.Visible = True
   oWS.Activate
   lTopRow = 1
   lBottomRow = 8

   For iIndex = lTopRow To lBottomRow
      oWS.Range("A1").Offset(iIndex + 1, 0).Select

      If oWS.Range(&quot;A1&quot;).Offset(iIndex + 1, 0) <> &quot;&quot; Then
         With oEX.Selection
            .EntireRow.Insert
         End With
      End If
   Next 

   If Not oWB Is Nothing Then
      With oWB
         .Save
         .Close
      End With
   End If

   Set oWB = Nothing
   Set oWS = Nothing

   If Not oEX Is Nothing Then
      oEX.Quit
   End If

   Set oEX = Nothing