Help on vba error Object variable or With block variable not set

[kit99]

In my code below, I'm trying to open up wb "Group1", find a perticular row in sheet "Kont", copy, and paste to sheet "Data1" in same wb.
I'm having problems with the find&copy-bit... Line "foundrow = ..." gives: Run-time error '91': Object variable or With block variable not set".
Anyone that can spot what's wrong - and how to fix it?

Sub FindAndCopyPartOfRow()    'Open another wb, find sh and row and copy to another sh in same wb

Application.ScreenUpdating = False
Dim fPath As String
Dim wb_gr As Workbook
Dim sh_kont As Worksheet, sh_data As Worksheet

    fPath = ThisWorkbook.Path
    If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
    End If

Set wb_gr = Workbooks.Open(ThisWorkbook.Path & "\group1.xlsm")
    With wb_gr
        Set sh_kont = .Worksheets("Kont")
        Set sh_data = .Worksheets("Data1")
    End With
           
[B]'These 4 lines work, but I don't want to use .activate and .select[/B]
        'Windows("group1.xlsm").Activate
        'Sheets("Kont").Select
        'foundrow = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Find("SUM alle kont", Cells(1, 1)).Row
        'Range("G" & foundrow & ":EO" & foundrow).Copy
        
[B]'These 2 lines is what I've been trying to run[/B]
        foundrow = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Find("SUM alle kont", Cells(1, 1)).Row
        wb_gr.sh_kont.Range("G" & foundrow & ":EO" & foundrow).Copy
        
        sh_data.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
wb_gr.Save
wb_gr.Close False
    
End Sub

 

[dmt32]

Hi,
try this update to your code & see if does what you want

Sub FindAndCopyPartOfRow()
'Open another wb, find sh and row and copy to another sh in same wb
    Dim fPath As String
    Dim wb_gr As Workbook
    Dim sh_kont As Worksheet, sh_data As Worksheet
    Dim FoundRow As Range
    
'**************************************************************
'<<<< this Code not used? >>>>>
    fPath = ThisWorkbook.Path
    If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
    End If
'**************************************************************
    On Error GoTo myerror
    Application.ScreenUpdating = False
   Set wb_gr = Workbooks.Open(ThisWorkbook.Path & "\group1.xlsm")
    
    With wb_gr
        Set sh_kont = .Worksheets("Kont")
        Set sh_data = .Worksheets("Data1")
    End With
    
    
    Set FoundRow = sh_kont.Columns(1).Find("SUM alle kont", lookat:=xlWhole, LookIn:=xlValues)
    If Not FoundRow Is Nothing Then
        FoundRow.Offset(, 6).Resize(1, 139).Copy
        sh_data.Range("C" & sh_data.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        wb_gr.Close True
    Else
        wb_gr.Close False
        MsgBox "Record Not Found", 48, "Not Found"
    End If
    
    Set wb_gr = Nothing
    
myerror:
    If Not wb_gr Is Nothing Then wb_gr.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Note there is a section in your code not used anywhere?

Dave

 

[kalak]

re: opening post
looks to me like in

Range("A1:A" & Range( etc

you need to specify the location of these ranges, otherwise the code has no idea where to look and so gives error.
There's several ways of doing this, including your approach of first activating the relevant location.

 

[kit99]

Hi,
try this update to your code & see if does what you want

Sub FindAndCopyPartOfRow()
'Open another wb, find sh and row and copy to another sh in same wb
    Dim fPath As String
    Dim wb_gr As Workbook
    Dim sh_kont As Worksheet, sh_data As Worksheet
    Dim FoundRow As Range
    
'**************************************************************
'<<<< this Code not used? >>>>>
    fPath = ThisWorkbook.Path
    If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
    End If
'**************************************************************
    On Error GoTo myerror
    Application.ScreenUpdating = False
   Set wb_gr = Workbooks.Open(ThisWorkbook.Path & "\group1.xlsm")
    
    With wb_gr
        Set sh_kont = .Worksheets("Kont")
        Set sh_data = .Worksheets("Data1")
    End With
    
    
    Set FoundRow = sh_kont.Columns(1).Find("SUM alle kont", lookat:=xlWhole, LookIn:=xlValues)
    If Not FoundRow Is Nothing Then
        FoundRow.Offset(, 6).Resize(1, 139).Copy
        sh_data.Range("C" & sh_data.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        wb_gr.Close True
    Else
        wb_gr.Close False
        MsgBox "Record Not Found", 48, "Not Found"
    End If
    
    Set wb_gr = Nothing
    
myerror:
    If Not wb_gr Is Nothing Then wb_gr.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Note there is a section in your code not used anywhere?

Dave

This worked just great. Thanks a lot for helping out.
Your note: I was trying to display to the thread only what I was having trouble with, so I deleted a lot of code that's woking ok - and forgot this part. Sorry.

 

[kit99]

re: opening post
looks to me like in

Range("A1:A" & Range( etc

you need to specify the location of these ranges, otherwise the code has no idea where to look and so gives error.
There's several ways of doing this, including your approach of first activating the relevant location.

I actually thought I had guided my code to the right wb and sh, but obviously failed spectacularly...
Thanks a lot for responding to my thread.