CODEWITHSUNDEEP
vbaexcel
Dyhouse
Dyhouse

Reputation: 83

Object variable not set (Error 91)

I am fairly new to the world of VBA and have been tasked with writing some code which will step through the company names which live in Column A and when that name is found, the code copies and pastes the relevant rows into a newly created workbook. It should then continue onto the next name and so on. During testing the code worked but I have gone into today and I am now getting the object variable error on the line rngG.Select

Can anyone possibly help as I have been looking at this for an hour and it is utterly baffling me now?

Sub CrystalUtilitesLtd()


Dim Wk As Workbook
Dim c As Range
Dim rngG As Range

Application.DisplayAlerts = False

For Each c In Intersect(ActiveSheet.UsedRange, Columns("a"))
    If c = "3rd Party - Crystal Utilities Ltd" Then
        If rngG Is Nothing Then Set rngG = c.EntireRow
        Set rngG = Union(rngG, c.EntireRow)
    End If
Next c
rngG.Select
Selection.Copy

Workbooks.Open "I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\TPI Registration Data Template1.xlsx"
Range("A2").Select
Selection.PasteSpecial xlPasteValues
Range("A1:AG1").EntireColumn.AutoFit
ActiveWorkbook.SaveAs ("I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\Crystal Utilities Ltd\Registrations_1010112503_" _
                        & Format(Now(), "YYYYMMDD") & ".xlsx")
ActiveWorkbook.Close

Call EnergyAnalystUK

Application.DisplayAlerts = True

End Sub

Upvotes: 1

Views: 224

Answers (1)

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

Replace the following two lines of code...

rngG.Select
Selection.Copy

With these lines

If Not rngG Is Nothing Then
    rngG.Copy
Else
    MsgBox "No range to copy.", vbExclamation
    Exit Sub
End If

The reason being that if c <> "3rd Party - Crystal Utilities Ltd" then the rngG object is never assigned a range, so it remains Nothing, and since you can't do Nothing.Select you'll get an Object Variable or With Block Not Set error.

With the above changes, your complete code would be like this...

Sub CrystalUtilitesLtd()


Dim Wk As Workbook
Dim c As Range
Dim rngG As Range

Application.DisplayAlerts = False

For Each c In Intersect(ActiveSheet.UsedRange, Columns("a"))
    If LCase(VBA.Trim(c)) = "3rd party - crystal utilities ltd" Then
        If rngG Is Nothing Then Set rngG = c.EntireRow
        Set rngG = Union(rngG, c.EntireRow)
    End If
Next c

If Not rngG Is Nothing Then
    rngG.Copy
    Workbooks.Open "I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\TPI Registration Data Template1.xlsx"
    Range("A2").Select
    Selection.PasteSpecial xlPasteValues
    Range("A1:AG1").EntireColumn.AutoFit
    ActiveWorkbook.SaveAs ("I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\Crystal Utilities Ltd\Registrations_1010112503_" _
                            & Format(Now(), "YYYYMMDD") & ".xlsx")
    ActiveWorkbook.Close
Else
    MsgBox "No range to copy.", vbExclamation
End If

Call EnergyAnalystUK

Application.DisplayAlerts = True

End Sub

Upvotes: 3

Related Questions