insert rows and data in Excel from VB6

This should do what you want (assuming your sheet is called Sheet1)

Sub FindValue()
    Dim v As Variant
    Dim x As Integer
    
    v = 3
    
    Sheet1.Activate
    
    Cells(1, 1).Select
    
    Selection.End(xlDown).Select
    
    x = ActiveCell.Row
    
    While (x > 1)
        If (Cells(x, 1).Value = v) Then
            MsgBox "Found Value: " + CStr(v)
        End If
        x = x - 1
    Wend
End Sub

Select allOpen in new window

just to add the add row code:

Sub FindValue()
    Dim v As Variant
    Dim x As Integer
    
    v = 3
    
    Sheet1.Activate
    
    Cells(1, 1).Select
    
    Selection.End(xlDown).Select
    
    x = ActiveCell.Row
    
    While (x > 1)
        If (Cells(x, 1).Value = v) Then
            'MsgBox "Found Value: " + CStr(v)
            Rows(x + 1).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            x = 1
        End If
        x = x - 1
    Wend
End Sub

Select allOpen in new window

do you mean VB6 or VBA ?   two quite different methodologies required as "using VB6" is usually a standalone app, where VBA is with Excel as per tagit method.

vb6.  thank you.  It will be Monday before I get a chance to test any possible solutions out.

If I accept a solution, I will give you opportunity to copy it to my other open question and earn another 500 points with same solution.

I posted this question, then narrowed the scope and reposted it:

https://www.experts-exchange.com/questions/26312621/VB6-copy-from-excel-spreadsheet-into-another-spreadseet.html

Thank you.

The VBA that I"ve posted can be used with in VB6 without that much modification once the initial Excel objects and variables have been set up.

In you're other question you've referred back to this question.  which one do you want ?

This one.  I will try modifying your vba on Mondy, but I'm not sure how how luck I will have with it.   I'll get back to you.  Thanks.

tagit, I don't have a clue how to convert this to vb6.  And your FindValue method only finds the first value.  I need to find the last value, then insert a row.

I'll run you through how to use VB6 to do this.  My method does find the last value because i start at the bottom not the top.

Not sure what approach you are going to take in terms of how your app is going to start.  Either you use a "sub Main()" or UserForm to start your app.  Regardless of which you choose you can always change it later.  I prefer using the Sub Main approach to initialise everything first.  Let's assume you have one module with 2 functions: Sub Main() and FindValue()

1) What you have to do first in VB6 is add a reference to the Excel Libraries
Go to the "Project" menu, and select "References". You will be presented with a long list of available references, just scroll down to "Microsoft Excel X.X Object Library" (where X.X is a version number - see post #14 for a list), then tick it and press OK.

2) Create a simple app to test it's working. This will just open excel then remove the reference to it (you will need to close excel manually)
Dim oXLApp as Excel.Application       'Declare the object variable
Set oXLApp = New Excel.Application  'Create a new instance of Excel
oXLApp.Visible = True               'Show it to the user
Set oXLApp = Nothing                'Disconnect from Excel (let the user take over)
' to close excel use oXLApp.Exit

3) Add the FindValue method and path to the excel file and see how it goes

I've attached a sample set of code

Public Sub Main()
    Dim oXLApp as Excel.Application
    Dim oXLBook as Excel.Workbook
    Set oXLApp = new Excel.Application
    Set oXLBook = oXLApp.Workbooks.Open("c:\my folder\my workbook.xls") 'Open an existing workbook
    FindValue(oXLBook)
    oXLApp.Exit
End Sub

Pubic Sub FindValue(ByRef xlWorkbook as Excel.Workbook)
    Dim v As Variant
    Dim x As Integer
    
    v = 3
    
    With xlWorkbook.Sheets("Sheet1")
        .Activate
        .Cells(1, 1).End(xlDown).Select
        x = .ActiveCell.Row

    While (x > 1)
        If (.Cells(x, 1).Value = v) Then
            'MsgBox "Found Value: " + CStr(v)
            .Rows(x + 1).Select
            .Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            x = 1
        End If
        x = x - 1
    Wend
    End With
End Sub

Select allOpen in new window

Just be aware I haven't tested this but it should be enough to get you started

thanks tagit.  I'll try it out this morning and get back to you.

Thanks for your detailed solution tagit.  

In sub main, I am getting "Object doesn't support this property or method", on this line:
FindValue (oXLBook)

I am using excel 2003 and have a reference to Excel 11.0 object library in my project.

Private Sub Command7_Click()
    Main
End Sub

Public Sub Main()
    Dim oXLApp As Excel.Application
    Dim oXLBook As Excel.Workbook
    Set oXLApp = New Excel.Application
    Set oXLBook = oXLApp.Workbooks.Open("c:\Book1.xls") 'Open an existing workbook
    FindValue (oXLBook)
    oXLApp.Exit
End Sub

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
    Dim v As Variant
    Dim x As Integer
    
    v = 23
    With xlWorkbook.Sheets("Sheet1")
        .Activate
        .Cells(1, 1).End(xlDown).Select
        x = .ActiveCell.Row

    While (x > 1)
        If (.Cells(x, 1).Value = v) Then
            MsgBox "Found Value: " + CStr(v)
            .Rows(x + 1).Select
            .Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            x = 1
        End If
        x = x - 1
    Wend
    End With
End Sub

Select allOpen in new window

Because it is a sub and not a function try removing the () ie FindValue oXLBook

I suspect it might be an error in the findvalue sub. Try setting a breakpoint in the findvalue function as close to the top as you csb

ok, I removed the () on the procedure call.

Now I get "Object doesn't support this property or method" on this line in FindValue:
x = .ActiveCell.Row

ok that should read

x = .Application.ActiveCell.Row

Thank you.  It's finding the value now, but not inserting the row.  Also I'm getting Object doesn't support this property or method"  on this line in sub Main:
oXLApp.Exit

Correction.  It looks like it is inserting the roiw.  Just need to take care of the last error and I think we might be there!

sorry that's oXLApp.Quit()

also change this line:

.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

to

.Rows(x).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Kewl.  Except since it's searching from the bottom, it needs to insert the row  after the row when it finds the first value.  Instead its inserting a row after finding the last value.  Which would be the first value if searching form the top.  I hope that makes sense.

Sorry I must've misread the question, i though you were trying to find the last occurrence of that number! :)



have a go with this modified code:

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
    Dim v As Variant
    Dim x As Integer
    
    v = 23
    With xlWorkbook.Sheets("Sheet1")
        .Activate
        x = 1
		While (.Cells(x,1).Value <> "")
			If (.Cells(x, 1).Value = v) Then
				MsgBox "Found Value: " + CStr(v)
				.Rows(x + 1).Select
				.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
				'stop the while loop as the value has been found
				break; 
			End If
			x = x + 1
		Wend
    End With
End Sub

Select allOpen in new window

I am trying to find the last occurrence.  If you're searching from the bottom, it is the first occurence.  I'll check out your code on your last post tomorrow...

Your previous code inserted a row after the first occurrence.

Sorry i don't understand what you're trying to do...  if you search from the top i would take that as the first occurence, and searching from the bottom is the last occurence??

I want to insert a row after the last occurrence.  Your code inserts a row before the last occurrence.
Before:
23
23
23

After (your code)
23
23
new row
23

After (need)
23
23
23
new row

ok ignore the code in my post #33218693 and use the previous code.  change the following 2 lines

.Rows(x).Select
.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

I'm still getting the same results.  It is inserting a row before the last value.

23
23
new row
23

Also, how do I get it to search on column 3 instead of column 1?  I tried changing this:
     If (.Cells(x, 1).Value = v) Then
to:
    If (.Cells(x, 3).Value = v) Then

That didnt' work.

Public Sub Main()
    Dim oXLApp As Excel.Application
    Dim oXLBook As Excel.Workbook
    Set oXLApp = New Excel.Application
    Set oXLBook = oXLApp.Workbooks.Open("c:\Book1.xls") 'Open an existing workbook
    FindValue
    oXLApp.Exit
End Sub

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
    Set xlsheet = oXLBook.Sheets.Item(1)
    Dim v As Variant
    Dim x As Integer
    
    v = 23
    
    With xlsheet
        .Activate
        .Cells(1, 1).End(xlDown).Select
        x = .ActiveCell.Row
    While (x > 1)
        If (.Cells(x, 1).Value = v) Then
            MsgBox "Found Value: " + CStr(v)
            '.Rows(x + 1).Select
            '.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            '
            .Rows(x).Select
            .Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            
            
            x = 1
        End If
        x = x - 1
    Wend
    End With
End Sub

Select allOpen in new window

Updated and searches by column

i've also attached a demo of this working in excel using vba

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
    Dim v As Variant
    Dim x As Integer
    Dim col As Integer
    Set xlsheet = oXLBook.Sheets.Item(1)

    col = 2
    v = 10
    With xlsheet
        .Activate
        .Cells(1, 1).End(xlDown).Select
        x = ActiveCell.Row

    While (x > 1)
        If (.Cells(x, col).Value = v) Then
            MsgBox "Found Value: " + CStr(v)
            .Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            x = 1
        Else
            ' put here to see how it is working
            'Debug.Print .Cells(x, col).Value
        End If
        x = x - 1
    Wend
    End With
End Sub

Select allOpen in new window

Book1.xls

It still doesn't work in vb6.  I get the same results.  And it only finds the value if it is in the first column.

I need to use vb6 because I will be sending the value to find as a variable from a recordset read in vb6.

"I get the same results"... It inserts the row before the last value:

10
10
new row
10

And it only finds the value if it is in the first column.

Can you post your code so I can see if there is anything missing?

Public Sub Main()
    Dim oXLApp As Excel.Application
    Dim oXLBook As Excel.Workbook
    Set oXLApp = New Excel.Application
    Set oXLBook = oXLApp.Workbooks.Open("c:\Book1.xls") 'Open an existing workbook
    FindValue
    oXLApp.Exit
End Sub
Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
    Dim v As Variant
    Dim x As Integer
    Dim Col As Integer
    Set xlsheet = oXLBook.Sheets.Item(1)

    Col = 2
    v = 10
    With xlsheet
        .Activate
        .Cells(1, 1).End(xlDown).Select
        x = ActiveCell.Row

    While (x > 1)
        If (.Cells(x, Col).Value = v) Then
            MsgBox "Found Value: " + CStr(v)
            .Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            x = 1
        Else
            ' put here to see how it is working
            'Debug.Print .Cells(x, col).Value
        End If
        x = x - 1
    Wend
    End With
End Sub

Select allOpen in new window

This works for me.  I've attached the excel spreadsheet.  I know it is in VBA but there isn't much different between VBA and VB6 in this instance.  You should be able to copy and paste the code.

Run the macro called runmacro and you should get a line inserted after the value 10 that it's search for in column 2

After you've run the macro can you tell me if it is doing what you want it to and if not what you would like it to do

Public Sub runmacro()
    FindValue ActiveWorkbook
End Sub

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
    Dim v As Variant
    Dim x As Integer
    Dim Col As Integer
    Dim xlsheet As Worksheet
    Set xlsheet = xlWorkbook.Sheets.Item(1)

    Col = 2
    v = 10
    With xlsheet
        .Activate
        .Cells(1, 1).End(xlDown).Select
        x = ActiveCell.Row

    While (x > 1)
        If (.Cells(x, Col).Value = v) Then
            MsgBox "Found Value: " + CStr(v)
            .Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            x = 1
        Else
            ' put here to see how it is working
            'Debug.Print .Cells(x, col).Value
        End If
        x = x - 1
    Wend
    End With
End Sub

Select allOpen in new window

Book1.xls

Yes, it does what it's supposed to do on your spreadsheet in vba.  It doesn't in vb6.

Have you tried it in vb6?

I am re-checking.  I think it is working with the last code.

It worked once, I thought ... now not working.  Please re-check my code again.

Public Sub Main()
    Dim oXLApp As Excel.Application
    Dim oXLBook As Excel.Workbook
    Set oXLApp = New Excel.Application
    Set oXLBook = oXLApp.Workbooks.Open("c:\Book1.xls") 'Open an existing workbook
    FindValue oXLBook
    oXLApp.Quit
End Sub
Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
    Dim v As Variant
    Dim x As Integer
    Dim col As Integer
    Dim xlsheet As Worksheet
    Set xlsheet = xlWorkbook.Sheets.Item(1)

    col = 2
    v = 10
    With xlsheet
        .Activate
        .Cells(1, 1).End(xlDown).Select
        x = ActiveCell.Row

    While (x > 1)
        If (.Cells(x, col).Value = v) Then
            MsgBox "Found Value: " + CStr(v)
            .Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            x = 1
        Else
            ' put here to see how it is working
                Debug.Print .Cells(x, col).Value
        End If
        x = x - 1
    Wend
    End With
End Sub

Select allOpen in new window

Your code looks fine.  Can you explain with a few screenshots maybe why you say you "thought it worked once and now it's not working"?

I don't have VB6 to test this (only Visual Studio 2005)

Does the app have to be developed in VB6 because you know there are free editions of the latest Visual Studio Express available for download from http://www.microsoft.com/express/Downloads/.  It would be a lot more stable and give you a wider scope of options in your development, especially using .NET and Office

Now it's not even finding the value.  I've ran a number of tests with different numbers, and I just got error "runtime error 6... overflow" on line:
x = ActiveCell.Row

I'll do this is vb .net and see if I can replicate your issue

I've been able to get it to work with this code

    Public Sub Main()
        Dim oXLApp As Excel.Application
        Dim oXLBook As Excel.Workbook
        oXLApp = New Excel.Application
        oXLApp.Visible = True
        oXLBook = oXLApp.Workbooks.Open("c:\Book1.xls") 'Open an existing workbook
        FindValue(oXLBook)
        oXLApp.Quit()
    End Sub
    Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
        Dim v As Object
        Dim x As Integer
        Dim Col As Integer
        Dim xlsheet As Excel.Worksheet
        xlsheet = xlWorkbook.Sheets.Item(1)

        Col = 3
        v = 10
        With xlsheet
            .Activate()
            .Cells(1, 1).End(Excel.XlDirection.xlDown).Select()
            x = xlsheet.Application.ActiveCell.Row

            While (x > 1)
                If (.Cells(x, Col).Value = v) Then
                    MsgBox("Found Value: " + CStr(v))
                    .Rows(x + 1).Insert(Shift:=Excel.XlDirection.xlDown, CopyOrigin:=Excel.XlInsertFormatOrigin.xlFormatFromLeftOrAbove)
                    x = 1
                Else
                    ' put here to see how it is working
                    'Debug.Print .Cells(x, col).Value
                End If
                x = x - 1
            End While
        End With
    End Sub

Select allOpen in new window

I'm getting runtime error stack overflow still here:
             x = xlsheet.Application.ActiveCell.Row

I had to make a couple of minor changes so it would compile in vb6.

Public Sub Main()
        Dim oXLApp As Excel.Application
        Dim oXLBook As Excel.Workbook
        Set oXLApp = New Excel.Application
        oXLApp.Visible = True
        Set oXLBook = oXLApp.Workbooks.Open("c:\Book1.xls") 'Open an existing workbook
        FindValue oXLBook
        oXLApp.Quit
    End Sub
    Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
        'Dim v As Object
        Dim v As Variant
        Dim x As Integer
        Dim Col As Integer
        Dim xlsheet As Excel.Worksheet
        Set xlsheet = xlWorkbook.Sheets.Item(1)

        Col = 3
        v = 10
        With xlsheet
            .Activate
            .Cells(1, 1).End(Excel.XlDirection.xlDown).Select
            x = xlsheet.Application.ActiveCell.Row

            While (x > 1)
                If (.Cells(x, Col).Value = v) Then
                    MsgBox ("Found Value: " + CStr(v))
                    '.Rows(x + 1).Insert(Shift:=Excel.XlDirection.xlDown, CopyOrigin:=Excel.XlInsertFormatOrigin.xlFormatFromLeftOrAbove)
                    .Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    x = 1
                Else
                    ' put here to see how it is working
                    'Debug.Print .Cells(x, col).Value
                End If
                x = x - 1
            Wend
        End With
    End Sub

Select allOpen in new window

wow we're almost there...

try

x = .Cells(1,1).End(Excel.XlDirection.xlDown).Row

same error ... overflow

x = .Cells(1, 1).End(Excel.XlDirection.xlDown).Row

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
        'Dim v As Object
        Dim v As Variant
        Dim x As Integer
        Dim Col As Integer
        Dim xlsheet As Excel.Worksheet
        Set xlsheet = xlWorkbook.Sheets.Item(1)

        Col = 3
        v = 10
        With xlsheet
            .Activate
            .Cells(1, 1).End(Excel.XlDirection.xlDown).Select
            'x = xlsheet.Application.ActiveCell.Row
            x = .Cells(1, 1).End(Excel.XlDirection.xlDown).Row

            While (x > 1)
                If (.Cells(x, Col).Value = v) Then
                    MsgBox ("Found Value: " + CStr(v))
                    '.Rows(x + 1).Insert(Shift:=Excel.XlDirection.xlDown, CopyOrigin:=Excel.XlInsertFormatOrigin.xlFormatFromLeftOrAbove)
                    .Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    x = 1
                Else
                    ' put here to see how it is working
                    'Debug.Print .Cells(x, col).Value
                End If
                x = x - 1
            Wend
        End With
    End Sub

Select allOpen in new window

also comment out the line above

        With xlsheet
            .Activate
            '.Cells(1, 1).End(Excel.XlDirection.xlDown).Select
            'x = xlsheet.Application.ActiveCell.Row
            x = .Cells(1, 1).End(Excel.XlDirection.xlDown).Row

Select allOpen in new window

ha of course!  redefine x as a long, not an integer

an integer can only hold 32000 and I'm suspecting for some reason it is going to the end of the spreadsheet

If am getting rt error "Method cells of object worksheet failed"
While (x > 1)
                If (.Cells(x, col).Value = v) Then

I removed the paren before .cells, same error

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
        'Dim v As Object
        Dim v As Variant
        Dim x As Long
        Dim col As Long
        Dim xlsheet As Excel.Worksheet
        Set xlsheet = xlWorkbook.Sheets.Item(1)

        col = 3
        v = 10
        With xlsheet
            .Activate
            '.Cells(1, 1).End(Excel.XlDirection.xlDown).Select
            'x = xlsheet.Application.ActiveCell.Row
            x = .Cells(1, 1).End(Excel.XlDirection.xlDown).Row
            
            
            While (x > 1)
                'If (.Cells(x, col).Value = v) Then
                If .Cells(x, col).Value = v Then
                    MsgBox ("Found Value: " + CStr(v))
                    '.Rows(x + 1).Insert(Shift:=Excel.XlDirection.xlDown, CopyOrigin:=Excel.XlInsertFormatOrigin.xlFormatFromLeftOrAbove)
                    .Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    x = 1
                Else
                    ' put here to see how it is working
                    'Debug.Print .Cells(x, col).Value
                End If
                x = x - 1
            Wend
        End With
    End Sub

Select allOpen in new window

Please try 3 things for me: changing v
from a variant to an integer,
then a long
then a string

I would also try getting the cells value first

Dim tmp as String

...

tmp = .Cells(x, col).Value

If (CInt(tmp) = v) Then

...

When I change v to an integer or string, I get rt error 424 - objec required.
String doesn't work either - rt error "Method cells of object worksheet failed"

Ok we need to do some further debugging (sorry to put you through all this but it really is necessary to find the faulting object)

Do you still get the same error withthe code below?  if not what is the output in the immediate window?

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
        'Dim v As Object
        Dim v As Variant
        Dim x As Long
        Dim col As Long
        Dim xlsheet As Excel.Worksheet
        Set xlsheet = xlWorkbook.Sheets.Item(1)

        col = 3
        v = 10
        With xlsheet
            .Activate
            x = .Cells(1, 1).End(Excel.XlDirection.xlDown).Row
            
            
            While (x > 1)
                'If .Cells(x, col).Value = v Then
                
                If False Then
                    MsgBox ("Found Value: " + CStr(v))
                    '.Rows(x + 1).Insert(Shift:=Excel.XlDirection.xlDown, CopyOrigin:=Excel.XlInsertFormatOrigin.xlFormatFromLeftOrAbove)
                    .Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    x = 1
                Else
                    ' put here to see how it is working
                    Debug.Print .Cells(x, col).Formula
                End If
                x = x - 1
            Wend
        End With
    End Sub

Select allOpen in new window

change the Debug.Print .Cells(x, col).Formula to

Debug.Print TypeName(.Cells(x, col).Value)

Another thing to try is remove the "With xlsheet" and access everything directly like this:

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
	Dim v As Variant
	Dim x As Long
	Dim col As Long
	Dim xlsheet As Excel.Worksheet
	Set xlsheet = xlWorkbook.Sheets.Item(1)

	col = 3
	v = 10
	xlsheet.Activate
	x = xlsheet.Cells(1, 1).End(Excel.XlDirection.xlDown).Row


	While (x > 1)
		If (xlsheet.Cells(x, col).Value = v) Then
			MsgBox ("Found Value: " + CStr(v))
			xlsheet.Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
			x = 1
		Else
			' put here to see how it is working
			'Debug.Print xlsheet.Cells(x, col).Value
		End If
		x = x - 1
	Wend
End Sub

Select allOpen in new window

Now I'm getting object required on the debug.print line.  It doesn't matter which version I use

'Debug.Print .Cells(x, col).Formula
                    Debug.Print TypeName(.Cells(x, col).Value)

Public Sub FindValue(ByRef xlWorkbook As Excel.Workbook)
        'Dim v As Object
        Dim v As Variant
        Dim x As Long
        Dim col As Long
        Dim xlsheet As Excel.Worksheet
        Set xlsheet = xlWorkbook.Sheets.Item(1)

        col = 3
        v = 10
        With xlsheet
            .Activate
            x = .Cells(1, 1).End(Excel.XlDirection.xlDown).Row
            
            
            While (x > 1)
                'If .Cells(x, col).Value = v Then
                
                If False Then
                    MsgBox ("Found Value: " + CStr(v))
                    '.Rows(x + 1).Insert(Shift:=Excel.XlDirection.xlDown, CopyOrigin:=Excel.XlInsertFormatOrigin.xlFormatFromLeftOrAbove)
                    .Rows(x + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    x = 1
                Else
                    ' put here to see how it is working
                    'Debug.Print .Cells(x, col).Formula
                    Debug.Print TypeName(.Cells(x, col).Value)
                End If
                x = x - 1
            Wend
        End With
    End Sub

Select allOpen in new window

If I comment back out Debug.print, the code runs but it does not find the value.

Not concerned about it finding the value just yet. We have to work out what object is causing you this grief
On the debug line add xlsheet to .Cells ie
Debug.Print xlsheet.Cells(x, col).Value

Debug.Print xlsheet.Cells(x, col).Value ... generates
     "Method cells of object worksheet failed"

Ok remove Cells(x, col) and replace with Range(cstr(chr(64+col) & x))

Method Range of object_worksheet failed

I am referencing Microsoft Excel 11.0 Object Library ... using Excel 2003

odd .. I tried this out on a different machine.  It doesn't generate an error, but it doesn't find the value or insert the row either.

Have you installed SP6 for Visual Studio 6?

Yes, that was the first thing I thought of.  I am working on a new machine and just recently installed vb6 on it.  What I installed was called "Cumulative Update for MS VB 6.0 SP6".

Does the machine you are running on also have .net framework?  Just curious if that has anything to do with the difference in machines here.  Mine does have .net.  My alternate older machine does not have .net.  The error doesn't generate on the older machine, but the script doesn't work either.

Xp pro, fully patched, office 2003 SP3

Have you googled the error "Method range of object_worksheet failed"?  A bunch of stuff comes up ... I can't really follow any of it.

Ihave but now we know it's not your code but something else I'll go back to that and work through the problems others have been trying

tagit, copy and paste your solution to my other open question and I'll give you points for both.  Thanks for help.

https://www.experts-exchange.com/questions/26312621/VB6-copy-from-excel-spreadsheet-into-another-spreadseet.html