Application-defined or Object-defined error

[nanofied]

Hello guys. In the code below, I am trying to compare 2 column on Worksheet(DUMPSheet) (this worksheet has already been activated in the code before.) and add the missing cell into Worksheet(DTSheet). When trying to execute the code I get the "Application-defined or Object-defined error" Error.

Dim REFNO_GE As Variant
REFNO_GE = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).row).Value


Dim REFNO_DT As Variant
REFNO_DT = Range("K2:K" & Range("K" & Rows.Count).End(xlUp).row).Value


Dim x, y As Variant
Dim match As Boolean
Dim GECounter, DTCounter As Long
    
GECounter = 2
DTCounter = LastDTRow + 1
    
For Each x In REFNO_GE
    match = False
    For Each y In REFNO_DT
        If x = y Then match = True
    Next y
    If Not match Then
        Worksheets(DUMPSheet).Range(Cells(GECounter, 7)).Select
        Selection.Copy
        Worksheets(DTSheet).Range(Cells(DTCounter, 1)).Select
        Selection.Paste
        DTCounter = DTCounter + 1
    End If
    GECounter = GECounter + 1
Next

 

[nanofied]

Sub ImportData()
Application.ScreenUpdating = False
Application.DisplayAlerts = False


    Dim wbkA As Workbook
    Dim wbkB As Workbook
    Dim ImportingSheet, ImportingWb, ImportingPath, DesignatedSheet, DesignatedWb, DesignatedPath, DUMPSheet, DTSheet As String
    Dim LastGERow, LastDTRow As Long
    
    ImportingSheet = "Email 2018"
    ImportingWb = "Gas Enquiry (Please close after use. Thank you.).xlsx"
    ImportingPath = "Z:\Gas Enquiry Test\" & ImportingWb
    DesignatedSheet = ""
    DesignatedWb = "Diversion Tracking Play Area.xlsm"
    DesignatedPath = "C:\Tracking System\Play Area\" & DesignatedWb
    DUMPSheet = "DO NOT DELETE"
    DTSheet = "DTSheet"
     
    'Open Diversion Tracking and remove filter
    Set wbkA = Workbooks.Open(fileName:=DesignatedPath)
    Workbooks(DesignatedWb).Activate
    Sheets(DTSheet).Activate
    Range("A3").Select
    
    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If
    
    'Find what is the last DT row before hiding rows with GasEnquiry No. Empty
    LastDTRow = ActiveSheet.Range("A4", ActiveSheet.Range("A4").End(xlDown)).Rows.Count + 3
    
    'Hide Rows with GasEnquiry No. empty
    ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=2, Criteria1:= _
        "<>"
    
    'Import GasEnquiry No. From DTSheet to DUMP for comparison
    ActiveSheet.Range(Cells(4, 2), Cells(LastDTRow, 2)).Select
    Selection.Copy
    Workbooks(DesignatedWb).Activate
    Sheets(DUMPSheet).Activate
    Range("K2").Select
    ActiveSheet.Paste
    
    'Remove Filter from DTSheet
    Sheets(DTSheet).Activate
    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If
    
    'Open Gas Enquiry and remove filter
    Set wbkB = Workbooks.Open(fileName:=ImportingPath)
    Workbooks(ImportingWb).Activate
    Sheets(ImportingSheet).Activate
    
    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If
    
    'Sort Gas Enquiry to obtain desired rows
    ActiveSheet.Range("$A$3:$O$901").AutoFilter Field:=4, Criteria1:="DPOM"
    ActiveSheet.Range("$A$3:$O$901").AutoFilter Field:=8, Criteria1:=Array( _
        "Cap off", "Diversion", "Enquiry", "Termination", "Verification", "="), Operator:= _
        xlFilterValues
        
    'Import Relevant Diversion Tracking Data to DUMP from GasEnquiry for comparison
    LastGERow = ActiveSheet.Range("B4", ActiveSheet.Range("B4").End(xlDown)).Rows.Count + 3
     
    ActiveSheet.Range(Cells(4, 1), Cells(LastGERow, 8)).Select
    Selection.Copy
    Workbooks(DesignatedWb).Activate
    Sheets(DUMPSheet).Activate
    Range("A2").Select
    ActiveSheet.Paste
    
    'Close Gas Enquiry, such that it is irrelevant
    Workbooks(ImportingWb).Close
    
        
    'Comparing data in DUMP Sheet
    Dim REFNOs_GE As Variant
    REFNOs_GE = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).row).Value


    Dim REFNOs_DT As Variant
    REFNOs_DT = Range("K2:K" & Range("K" & Rows.Count).End(xlUp).row).Value


    Dim REFNO_GE, REFNO_DT As Variant
    Dim match As Boolean
    Dim GECounter, DTCounter As Long
    
    GECounter = 2
    DTCounter = LastDTRow + 1
    
    For Each REFNO_GE In REFNOs_GE
        match = False
        For Each REFNO_DT In REFNOs_DT
            If REFNO_GE = REFNO_DT Then match = True
        Next REFNO_DT
        If Not match Then
            Worksheets(DUMPSheet).Range(Worksheets(DUMPSheet).Cells(GECounter, 7)).Select
            Selection.Copy
            Worksheets(DTSheet).Range(Worksheets(DTSheet).Cells(DTCounter, 1)).Select
            Selection.Paste
            
            'Range("K" & Range("K" & Rows.Count).End(xlUp).row + 1) = REFNO_GE
            
            'Worksheets(DTSheet).Range(Cells(DTCounter, 1)).Value = REFNO_GE
            
            'Worksheets(DTSheet).Range(Cells(DTCounter, 1)).Value = Worksheets(DUMPSheet).Range(Cells(GECounter, 7)).Value
            DTCounter = DTCounter + 1
        End If
        'GECounter = GECounter + 1
    Next


    'Clear DUMP sheet contents to clear memory
'    Sheets(DUMPSheet).Activate
'    Range(Cells(2, 1), Cells(LastGERow, 11)).ClearContents
'    Range(Cells(2, 1), Cells(LastGERow, 11)).ClearFormats


    MsgBox "Import Done"


Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

This is my whole code, I would appreciate if you could point out my mistakes.

 

[MARK858]

I will have a look when I get home from work tonight as just leaving but even though it is not creating your error all the variables below are declared as Variant not String....

ImportingSheet, ImportingWb, ImportingPath, DesignatedSheet, DesignatedWb, DesignatedPath & DUMPSheet

and

LastGERow is declared as a Variant and not a Long.

but like I stated that is not creating your error.

 

[Fluff]

You can only select a cell on the active sheet, so this part of your code cannot work

If Not match Then
            [COLOR=#0000ff]Worksheets(DUMPSheet).Range(Worksheets(DUMPSheet).Cells(GECounter, 7)).Select
            Selection.Copy
            Worksheets(DTSheet).Range(Worksheets(DTSheet).Cells(DTCounter, 1)).Select
            Selection.Paste[/COLOR]
            
            'Range("K" & Range("K" & Rows.Count).End(xlUp).row + 1) = REFNO_GE
            
            'Worksheets(DTSheet).Range(Cells(DTCounter, 1)).Value = REFNO_GE
            
            'Worksheets(DTSheet).Range(Cells(DTCounter, 1)).Value = Worksheets(DUMPSheet).Range(Cells(GECounter, 7)).Value
            DTCounter = DTCounter + 1
        End If

Try

Worksheets(DUMPSheet).Cells(GECounter, 7).Copy Worksheets(DTSheet).Cells(DTCounter, 1)

 

[nanofied]

Hi fluff, I have tried this code when you first replied to this thread. Let me try again and get back to you

 

[Fluff]

It's different code to my first suggestion
With this

Worksheets(DUMPSheet).Range(Worksheets(DUMPSheet).Cells(GECounter, 7)).copy

If the value of cells(GECounter,7) is Fluff then that code line becomes

Worksheets(DUMPSheet).Range(Fluff).copy

So its trying to copy a named range, rather than a cell

 

[nanofied]

Fluff Sir, I love you! This worked perfectly. How may I show my gratitude?


I have another question although this is regarding the aesthetics of the cells. I noticed that the cells that I pasted have a color fill in their cells. How many I avoid that, or would I have the to use a line of code to change the cell interior to white?

 

[Fluff]

Simply change that line to

Worksheets(DTSheet).Cells(DTCounter, 1).value=Worksheets(DUMPSheet).Cells(GECounter, 7).value

This will copy the value only

 

[nanofied]

This worked perfectly! Thank you again Fluff

 

[Fluff]

Glad we could help & thanks for the feedback