Object Variable or With block variable not set error in VBA

jbuist

New Member
Joined
Mar 16, 2018
Messages
29
Hello. I am relatively new tocoding and have a problem. I have created a script that pulls data from multiple sheets into one sheet and adds the name of the original file (“Widget#”). I’m trying to copy and fill the empty cells with the file name as I will be creating a pivot table. I added the code beginning at Dim rng AsRange, cell As Range and I now get the error “Object variable of With block variable not set”. I’m not seeing where I have set an object. Code is below, current output and desired output.


Sub simpleXlsMerger()
Dim bookList As Workbook
Dim xfile(999) As String

Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObjAs Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
x = 1
Set dirObj = mergeObj.Getfolder("H:\Widgets")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

Range("E1:F9").Copy
xfile(x) = ActiveWorkbook.Name
x = x + 1
ThisWorkbook.Worksheets(1).Activate

Range("B65536").End(xlUp).Offset(1, 0).PasteSpecialPaste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B:B")
y = 1
For Each cel In SrchRng
If cel.Value ="Test" Then
cel.Offset(0, -1).Value =xfile(y)
y = y + 1
End If
Next cel
bookList.Saved = True
bookList.Close
Next
Columns("A:B").EntireColumn.AutoFit
Dim rngAs Range, cell As Range
rng = Range("A2").Select
For Each cell In rng
Selection.End(xlDown).Select
ActiveCell.Offset(-1,0).Select
rng(Selection,Selection.End(xlUp)).Select
Selection.FillDown
Nextcell
End Sub


CURRENT OUTPUT

Widget 1
Test
Count
Total Records

0
Untimely Notification

0
Untimely Dismissal

0
Widget 2
Test
Count
Total Records

12
Untimely Notification

0
Untimely Dismissal

0
Widget 3
Test
Count
Total Records

0
Untimely Notification

0
Untimely Dismissal

0
Widget 4
Test
Count
Total Records

0
Untimely Notification

0
Untimely Dismissal

0
Widget 5
Test
Count
Total Records

0
Untimely Notification

0
Untimely Dismissal

0
Widget 6
Test
Count
Total Records

0
Untimely Notification

0
Untimely Dismissal

0

<tbody>
</tbody>


DESIRED OUTPUT

Widget 1
Test
Count
Widget 1
Total Records

0
Widget 1
Untimely Notification

0
Widget 1
Untimely Dismissal

0
Widget 2
Test
Count
Widget 2
Total Records

12
Widget 2
Untimely Notification

0
Widget 2
Untimely Dismissal

0
Widget 3
Test
Count
Widget 3
Total Records

0
Widget 3
Untimely Notification

0
Widget 3
Untimely Dismissal

0
Widget 4
Test
Count
Widget 4
Total Records

0
Widget 4
Untimely Notification

0
Widget 4
Untimely Dismissal

0
Widget 5
Test
Count
Widget 5
Total Records

0
Widget 5
Untimely Notification

0
Widget 5
Untimely Dismissal

0
Widget 6
Test
Count
Widget 6
Total Records

0
Widget 6
Untimely Notification

0
Widget 6
Untimely Dismissal

0

<tbody>
</tbody>
 
Last edited:

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Thanks Joe! I'll add tags moving forward.

Not sure why it copied that way, but "Next Cell" is two words in my code. Still getting error. Any ideas?

Thank you!!
 
Upvote 0
Not sure why it copied that way, but "Next Cell" is two words in my code. Still getting error. Any ideas?
If you re-post your code using Code Tags, so that all the spacing and indenting is maintained, I will take a look.
A lot of times, it means that you are missing something like an "End If", "Next", or you are using the wrong one.
It is a lot easier to see this when the code is indented, so the appropriate opening/closing block lines all line up.
 
Upvote 0
Thanks Joe! I appreciate your patience.

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim xfile(999) As String

Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObjAs Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
x = 1
Set dirObj = mergeObj.Getfolder("H:\Widgets")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

Range("E1:F9").Copy
xfile(x) = ActiveWorkbook.Name
x = x + 1
ThisWorkbook.Worksheets(1).Activate

Range("B65536").End(xlUp).Offset(1, 0).PasteSpecialPaste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B:B")
y = 1
For Each cel In SrchRng
If cel.Value ="Test" Then
cel.Offset(0, -1).Value =xfile(y)
y = y + 1
End If
Next cel
bookList.Saved = True
bookList.Close
Next
Columns("A:B").EntireColumn.AutoFit
Dim rngAs Range, cell As Range
rng = Range("A2").Select
For Each cell In rng
Selection.End(xlDown).Select
ActiveCell.Offset(-1,0).Select
rng(Selection,Selection.End(xlUp)).Select
Selection.FillDown
Nextcell
End Sub


 
Last edited:
Upvote 0
Except you didn't add the code tags...

The easiest way I think to do it is to copy and paste your code here, then select the whole block of code, and click on the Code Tags button in the Editor (last icon - looks like a hashtag).
If you do it correctly, your code should look something like this:
Code:
Sub Test()

    If Range("A1") = "Test" Then
        MsgBox "This is a test"
    Else
        MsgBox "This is NOT a test"
    End If
    
End Sub
When it is in this structure, it is easy to see my "End If" line up with my "If". So it makes it much easier to view and spot any errors or missing items. People helping you here should not have to re-format all your code in order to help you - make it easy for us to help you!
 
Upvote 0
So, I went through and fixed up your code a bit. I didn't see any glaring issues.
However, a few things:
- You declared all your variables instead of x and y. I added those (shouldn't really be a problem unless you have "Option Explicit" turned on, but a best practice nonetheless)
- You have some variable declarations inside loops. Shouldn't cause errors, but leads to unnecessarily declaring them multiple times. Best practice is to typically declare all your variables at the very beginning of your code.

So this is what the new formatted code would look like:
Code:
Sub simpleXlsMerger()


    Dim x As Long, y As Long
    Dim bookList As Workbook
    Dim xfile(999) As String
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Dim SrchRng As Range, cel As Range
    Dim rng As Range, cell As Range
    
    Application.ScreenUpdating = False
    
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
    x = 1
    Set dirObj = mergeObj.Getfolder("H:\Widgets")
    Set filesObj = dirObj.Files
    
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)

        Range("E1:F9").Copy
        xfile(x) = ActiveWorkbook.Name
        x = x + 1
        ThisWorkbook.Worksheets(1).Activate

        Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Set SrchRng = Range("B:B")
        y = 1
        
        For Each cel In SrchRng
            If cel.Value = "Test" Then
                cel.Offset(0, -1).Value = xfile(y)
                y = y + 1
            End If
        Next cel

        bookList.Saved = True
        bookList.Close
    Next

    Columns("A:B").EntireColumn.AutoFit
    
    rng = Range("A2:A60000").Select
    For Each cell In rng
        Selection.End(xlDown).Select
        ActiveCell.Offset(-1, 0).Select
        rng(Selection, Selection.End(xlUp)).Select
        Selection.FillDown
    Next cell
    
End Sub
There is other cleanup which code be done (like removing a lot of those Select statements), but I did not bother with that.
I do not get any errors when I compile your code. Are you able to compile it?
Or do you just get an error when running it (if so, which line does it seem to have an issue with)?
 
Upvote 0
Let's try this.

Code:
Sub simpleXlsMerger()
Dim bookList As Workbook
Dim xfile(999) As String

Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
x = 1
Set dirObj = mergeObj.Getfolder("H:\Widgets")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
 
Range("E1:F9").Copy
xfile(x) = ActiveWorkbook.Name
x = x + 1
ThisWorkbook.Worksheets(1).Activate
 
Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
Code:
Application.CutCopyMode = False
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B:B")
y = 1
For Each cel In SrchRng
    If cel.Value = "Test" Then
        cel.Offset(0, -1).Value = xfile(y)
        y = y + 1
    End If
Next cel
bookList.Saved = True
bookList.Close
Next
    Columns("A:B").EntireColumn.AutoFit
Dim rng As Range, cell As Range
rng = Range("A2:A60000").Select
For Each cell In rng
    Selection.End(xlDown).Select
    ActiveCell.Offset(-1, 0).Select
    rng(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
Next cell
End Sub
 
Last edited:
Upvote 0
Joe,

I copied your code and am still getting the objecterror. It seems to loop through the “Foreach”….”Next cel” part of the code.

Ideas?

Thank you again for your insight and patience. As mentioned, I’m somewhat new to all this.

 
Upvote 0
So, does it give you a "debug" option?
If so, exactly which line does it highlight?
If you hover over the variables (like "y"), what does it show for the value?
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top