Error in VBA I have been running for a year

[jondavis1987]

What's in asterisks will give me an error. Run-time error '91': Object variable or With block variable not set. This code has worked for me for over a year. I haven't changed anything and now i'm getting this error.

ption Explicit


Sub Open_Workbook()


    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim fName As String
    Dim lastRow As Long
   
'   Capture current workbook as source workbook
    Set srcWB = ActiveWorkbook




'   Open destination workbook and capture it as destination workbook
    Workbooks.Open "C:\Users\jdavis\Dropbox\Quality Control\Aggregates\Stockpile Gradation\Stockpile Charts.xlsx"
    Set destWB = ActiveWorkbook
   
'   Unhide Sheet
    destWB.Sheets("Sheet1").Visible = True
    destWB.Sheets("Moistures").Visible = True
   
'   Find last row of Sheet1 data in destination workbook
    lastRow = destWB.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row + 1
   
'   Copy Sheet1 data from source workbook to destination workbook
    srcWB.ActiveSheet.Range("F5").Copy
    destWB.Sheets("Sheet1").Range("A" & lastRow).Resize(14, 1).PasteSpecial xlPasteValues
    srcWB.ActiveSheet.Range("B4").Copy
    destWB.Sheets("Sheet1").Range("D" & lastRow).Resize(14, 1).PasteSpecial xlPasteValues
    srcWB.ActiveSheet.Range("B5").Copy
    destWB.Sheets("Sheet1").Range("E" & lastRow).Resize(14, 1).PasteSpecial xlPasteValues
    srcWB.ActiveSheet.Range("A12:A25").Copy
    destWB.Sheets("Sheet1").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.ActiveSheet.Range("F12:F25").Copy
    destWB.Sheets("Sheet1").Range("G" & lastRow).PasteSpecial xlPasteValues
     
     
      '   Find last row of Sheet1 data in destination workbook
    lastRow = destWB.Sheets("Moistures").Cells(Rows.Count, "A").End(xlUp).Row + 1

'   Copy Moistures data from source workbook to destination workbook
    srcWB.ActiveSheet.Range("F5").Copy
    destWB.Sheets("Moistures").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.ActiveSheet.Range("B4").Copy
    destWB.Sheets("Moistures").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.ActiveSheet.Range("B5").Copy
    destWB.Sheets("Moistures").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.ActiveSheet.Range("F8").Copy
    destWB.Sheets("Moistures").Range("F" & lastRow).PasteSpecial xlPasteValues



'   Hide Sheet
    destWB.Sheets("Sheet1").Visible = False
    destWB.Sheets("Moistures").Visible = False
   
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True
   
    Dim srcWB1 As Workbook
    Dim destWB1 As Workbook
    Dim fName1 As String
    Dim lastRows As Long
    Dim destName As String
    Dim wsName As String

'   Capture current workbook as source workbook
    Set srcWB1 = ActiveWorkbook


'   Set the name of the destination workbook
    destName = Range("B1").Text

'   Set the name of the destination worksheet
    wsName = "Agg Gradations"

'   Open destination workbook and capture it as destination workbook
    Workbooks.Open "C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Misc\Gradations Changes\" & destName & ".xlsm"
    Set destWB1 = ActiveWorkbook
   
Dim rg As Range
Dim srcName As String
srcName = srcWB.ActiveSheet.Range("B5")
Application.DisplayAlerts = False
For Each rg In destWB1.Sheets(wsName).Range("A1:Z100") ' change the range here
    If rg = srcName Then GoTo Found
Next rg

Found:

    srcWB.ActiveSheet.Range("L12:L25").Copy
**********  rg.Offset(1, 0).PasteSpecial xlPasteValues ***********



'   Save changes and close destination workbook
    destWB1.Close SaveChanges:=True




'   Export source workbook to PDF
    With srcWB
  Dim LocationName As String
     fName = ActiveSheet.Range("A2").Value
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
             "C:\Users\Jdavis\Dropbox\Quality Control\Aggregates\Stockpile Gradation\" & fName, Quality:=xlQualityStandard, _
             includeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
End Sub

 

[VBasic2008]

The error most likely occurred because srcName was not found and rg was nothing. See how I handled it in my solution which is not tested.

Option Explicit

Sub Open_Workbook()

' Part 1

    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim src As Worksheet
    Dim dest1 As Worksheet
    Dim dest2 As Worksheet
    Dim lastRow As Long

'   Capture current workbook as source workbook
    Set srcWB = ThisWorkbook ' The workbook containing this code.

'   Open destination workbook and capture it as destination workbook
    Set destWB = Workbooks.Open("C:\Users\jdavis\Dropbox\Quality Control\Aggregates\Stockpile Gradation\Stockpile Charts.xlsx")

'   Unhide Sheets
    destWB.Sheets("Sheet1").Visible = True
    destWB.Sheets("Moistures").Visible = True
    Set dest1 = destWB.Sheets("Sheet1")
    Set dest2 = destWB.Sheets("Moistures")
 
'   Find last row of Sheet1 data in destination workbook
    lastRow = dest1.Cells(dest1.Rows.Count, "A").End(xlUp).Row + 1

    Set src = srcWB.ActiveSheet ' Should be the name e.g. srcWB.Worksheets("Sheet1").
'   Copy Sheet1 data from source workbook to destination workbook
    dest1.Range("A" & lastRow).Resize(14, 1).Value = src.Range("F5").Value
    dest1.Range("D" & lastRow).Resize(14, 1).Value = src.Range("B4").Value
    dest1.Range("E" & lastRow).Resize(14, 1).Value = src.Range("B5").Value
    dest1.Range("F" & lastRow).Value = src.Range("A12:A25").Value
    dest1.Range("G" & lastRow).Value src.Range("F12:F25").Value
  
'   Find last row of Moistures data in destination workbook
    lastRow = dest2.Cells(dest2.Rows.Count, "A").End(xlUp).Row + 1

'   Copy Moistures data from source workbook to destination workbook
    dest2.Range("A" & lastRow).Value = src.Range("F5").Value
    dest2.Range("D" & lastRow).Value = src.Range("B4").Value
    dest2.Range("E" & lastRow).Value = src.Range("B5").Value
    dest2.Range("F" & lastRow).Value = src.Range("F8").Value

'   Hide Sheets
    dest1.Visible = False
    dest2.Visible = False

'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

'Part 2

    Dim rg As Range
    Dim srcValue As String
    Dim destName As String
    Dim wsName As String

'   Set the name of the destination workbook
    destName = src.Range("B1").Text ' usually Value ?

'   Set the name of the destination worksheet
    wsName = "Agg Gradations"

'   Open destination workbook and capture it as destination workbook
    Set destWB = Workbooks.Open("C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Misc\Gradations Changes\" & destName & ".xlsm")

    srcValue = src.Range("B5")
    ' Application.DisplayAlerts = False ' not sure what this is supposed to prevent. Uncomment if necessary.
    For Each rg In destWB.Worksheets(wsName).Range("A1:Z100").Cells ' change the range here
        If rg.Value = srcValue Then
        ' srcValue found.
            rg.Offset(1, 0).Resize(14).Value = src.Range("L12:L25").Value
            Exit For
        Else
        ' srcValue NOT found.
            ' Are you sure that it will always be found?
            ' This could have been the reason for the error.
        End If
    Next rg

'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

'   Export source workbook to PDF
    fName = src.Range("A2").Value
    src.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         "C:\Users\Jdavis\Dropbox\Quality Control\Aggregates\Stockpile Gradation\" & fName, Quality:=xlQualityStandard, _
         includeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

 

[jondavis1987]

The error most likely occurred because srcName was not found and rg was nothing. See how I handled it in my solution which is not tested.

Option Explicit

Sub Open_Workbook()

' Part 1

    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim src As Worksheet
    Dim dest1 As Worksheet
    Dim dest2 As Worksheet
    Dim lastRow As Long

'   Capture current workbook as source workbook
    Set srcWB = ThisWorkbook ' The workbook containing this code.

'   Open destination workbook and capture it as destination workbook
    Set destWB = Workbooks.Open("C:\Users\jdavis\Dropbox\Quality Control\Aggregates\Stockpile Gradation\Stockpile Charts.xlsx")

'   Unhide Sheets
    destWB.Sheets("Sheet1").Visible = True
    destWB.Sheets("Moistures").Visible = True
    Set dest1 = destWB.Sheets("Sheet1")
    Set dest2 = destWB.Sheets("Moistures")

'   Find last row of Sheet1 data in destination workbook
    lastRow = dest1.Cells(dest1.Rows.Count, "A").End(xlUp).Row + 1

    Set src = srcWB.ActiveSheet ' Should be the name e.g. srcWB.Worksheets("Sheet1").
'   Copy Sheet1 data from source workbook to destination workbook
    dest1.Range("A" & lastRow).Resize(14, 1).Value = src.Range("F5").Value
    dest1.Range("D" & lastRow).Resize(14, 1).Value = src.Range("B4").Value
    dest1.Range("E" & lastRow).Resize(14, 1).Value = src.Range("B5").Value
    dest1.Range("F" & lastRow).Value = src.Range("A12:A25").Value
    dest1.Range("G" & lastRow).Value src.Range("F12:F25").Value
 
'   Find last row of Moistures data in destination workbook
    lastRow = dest2.Cells(dest2.Rows.Count, "A").End(xlUp).Row + 1

'   Copy Moistures data from source workbook to destination workbook
    dest2.Range("A" & lastRow).Value = src.Range("F5").Value
    dest2.Range("D" & lastRow).Value = src.Range("B4").Value
    dest2.Range("E" & lastRow).Value = src.Range("B5").Value
    dest2.Range("F" & lastRow).Value = src.Range("F8").Value

'   Hide Sheets
    dest1.Visible = False
    dest2.Visible = False

'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

'Part 2

    Dim rg As Range
    Dim srcValue As String
    Dim destName As String
    Dim wsName As String

'   Set the name of the destination workbook
    destName = src.Range("B1").Text ' usually Value ?

'   Set the name of the destination worksheet
    wsName = "Agg Gradations"

'   Open destination workbook and capture it as destination workbook
    Set destWB = Workbooks.Open("C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Misc\Gradations Changes\" & destName & ".xlsm")

    srcValue = src.Range("B5")
    ' Application.DisplayAlerts = False ' not sure what this is supposed to prevent. Uncomment if necessary.
    For Each rg In destWB.Worksheets(wsName).Range("A1:Z100").Cells ' change the range here
        If rg.Value = srcValue Then
        ' srcValue found.
            rg.Offset(1, 0).Resize(14).Value = src.Range("L12:L25").Value
            Exit For
        Else
        ' srcValue NOT found.
            ' Are you sure that it will always be found?
            ' This could have been the reason for the error.
        End If
    Next rg

'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

'   Export source workbook to PDF
    fName = src.Range("A2").Value
    src.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         "C:\Users\Jdavis\Dropbox\Quality Control\Aggregates\Stockpile Gradation\" & fName, Quality:=xlQualityStandard, _
         includeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

You are correct. Src had a cell value of a name of a material and then the size 3/8. Someone yesterday edited the matching name and 3/8 in destwb to show name and 3/8" . The name should always be found, unless it's a brand new material. assuming people stop editing what they're not supposed to. In this case it was my boss so I can't exactly tell him to not edit things.