Data Sorting with an If Then statement not working

Question

So I have a query that I am trying to pull and sort data from using a For Loop and an If Then statement. The statement's purpose is to take my criteria and look through the data for things that match. If they match then it copies a value from that data into a column. I have three sets of criteria that look through the same data. Each criteria has 3 strings and a date range.

For some reason It copies all the data to all three Paste locations. See the image for Reference:

The Cells Colored on the right are my first set of criteria. The second set is directly below that. The colored cells on the left is my data.

The only thing I can think of is that I am Referencing the cell locations wrong. I am currently using a (Row, Column) coordinate system. Example: .Cells("B2") is the same as .Cells(2, 2).

Here is the code in question

'
    Dim j As Long

    For j = 1 To ActiveWorkbook.Connections.Count
        ActiveWorkbook.Connections(j).OLEDBConnection.BackgroundQuery = False
    Next

    ActiveWorkbook.RefreshAll

    Worksheets("Query").Activate
    ActiveSheet.ListObjects("Table_WinSPCData.accdb").Range.AutoFilter Field:=14 _
    , Criteria1:="=81024 OK", Operator:=xlOr, Criteria2:="=81111 OK"

ActiveSheet.ListObjects("Table_WinSPCData.accdb").Range.AutoFilter Field:=1, _
    Criteria1:=Array("DD_IMPELLER_SEAL_RING_004", "DD_IMPELLER_SEAL_RING_005", _
    "DD_IMPELLER_SEAL_RING_007", "DD_IMPELLER_SEAL_RING_008", _
    "GD_1ST_STAGE_IMPELLER_SEAL_RING", "GD_2ND_STAGE_IMPELLER_SEAL_RING", _
    "IMPELLER_SEAL_RING", "INTERSTAGE_SEAL_RING", "MOTOR_SEAL_RING", _
    "MOTOR_SEAL_RING_WITH_PILOT", "MOTOR_SEAL_RING_WITH_PILOT_005"), Operator:= _
    xlFilterValues

    Range("A:A,E:E,H:H,I:I").Select
    Range("Table_WinSPCData.accdb[[#Headers],[VALUE_]]").Activate
    Range("A:A,E:E,H:H,I:I,N:N").Select
    Range("Table_WinSPCData.accdb[[#Headers],[TAG_VALUE]]").Activate
    Selection.Copy
    Sheets("1").Range("A1").PasteSpecial xlPasteValues

    Application.CutCopyMode = False


Dim i As Long
Dim AssetRight1 As Range
Dim AssetRight2 As Range
Dim AssetRight3 As Range
Dim AssetLeft1 As Range

Dim PartnameRight1 As Range
Dim PartnameRight2 As Range
Dim PartnameRight3 As Range
Dim PartnameLeft1 As Range

Dim VariablenameRight1 As Range
Dim VariablenameRight2 As Range
Dim VariablenameRight3 As Range
Dim VariablenameLeft1 As Range

Dim Criteria1paste As Range
Dim Criteria2paste As Range
Dim Criteria3paste As Range


    Set AssetRight1 = Cells(2, 20)
    Set AssetRight2 = Cells(3, 20)
    Set AssetRight3 = Cells(4, 20)
    Set AssetLeft1 = Cells(2 + i, 5)

    Set PartnameRight1 = Cells(2, 21)
    Set PartnameRight2 = Cells(3, 21)
    Set PartnameRight3 = Cells(4, 21)
    Set PartnameLeft1 = Cells(2 + i, 1)

    Set VariablenameRight1 = Cells(2, 22)
    Set VariablenameRight2 = Cells(3, 22)
    Set VariablenameRight3 = Cells(4, 22)
    Set VariablenameLeft1 = Cells(2 + i, 2)

    Set Criteria1paste = Cells(2 + i, 8)
    Set Criteria2paste = Cells(2 + i, 9)
    Set Criteria3paste = Cells(2 + i, 10)

    For i = 0 To 20

    If AssetRight1 = AssetLeft1 Then If VariablenameRight1 = VariablenameLeft1 Then If PartnameRight1 = PartnameLeft1 Then If Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 3) <= Worksheets("Date").Range("D4") Then Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy

            Criteria1paste.PasteSpecial xlPasteValues

                    Application.CutCopyMode = False

    If AssetRight2 = AssetLeft1 Then If VariablenameRight2 = VariablenameLeft1 Then If PartnameRight2 = PartnameLeft1 Then If Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 3) <= Worksheets("Date").Range("D4") Then Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy

            Criteria2paste.PasteSpecial xlPasteValues

                    Application.CutCopyMode = False

    If AssetRight3 = AssetLeft1 Then If VariablenameRight3 = VariablenameLeft1 Then If PartnameRight3 = PartnameLeft1 Then If Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 3) <= Worksheets("Date").Range("D4") Then Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy

            Criteria3paste.PasteSpecial xlPasteValues

                    Application.CutCopyMode = False

    Next i

End Sub

Sorry it is such a mess. I recorded most of it so it's all over the place. thanks in Advance.

Update Okay, here is the For Next Code As right now. It has a problem with the For Next loop for some reason. It says that there is a Next without a For.

For i = 0 To 20

    If AssetRight1 = AssetLeft1 And _
    VariablenameRight1 = VariablenameLeft1 And _
    PartnameRight1 = PartnameLeft1 And _
        Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 7) <= Worksheets("Date").Range("D4") Then

            Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy Criteria1paste


    If AssetRight2 = AssetLeft1 And _
    VariablenameRight2 = VariablenameLeft1 And _
    PartnameRight2 = PartnameLeft1 And _
        Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 7) <= Worksheets("Date").Range("D4") Then

            Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy Criteria2paste

    If AssetRight3 = AssetLeft1 And _
    VariablenameRight3 = VariablenameLeft1 And _
    PartnameRight3 = PartnameLeft1 And _
        Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 7) <= Worksheets("Date").Range("D4") Then

            Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy Criteria3paste

Next i

Keizzerweiss · Accepted Answer

Okay I got it figured out. My biggest problem was my dates. They needed to be done like the code below with As Date. The second biggest problem was all my Set functions. Because i'm comparing the strings inside the cells, you can't use them as `.Range' objects. Here is the code.

Sub update_query_and_slide_1()



Dim j As Long

For j = 1 To ActiveWorkbook.Connections.Count

    ActiveWorkbook.Connections(j).OLEDBConnection.BackgroundQuery = False

Next

ActiveWorkbook.RefreshAll

Worksheets("Query").Activate
ActiveSheet.ListObjects("Table_WinSPCData.accdb").Range.AutoFilter Field:=14 _
    , Criteria1:="=81024 OK", Operator:=xlOr, Criteria2:="=81111 OK"

ActiveSheet.ListObjects("Table_WinSPCData.accdb").Range.AutoFilter Field:=1, _
    Criteria1:=Array("DD_IMPELLER_SEAL_RING_004", "DD_IMPELLER_SEAL_RING_005", _
    "DD_IMPELLER_SEAL_RING_007", "DD_IMPELLER_SEAL_RING_008", _
    "GD_1ST_STAGE_IMPELLER_SEAL_RING", "GD_2ND_STAGE_IMPELLER_SEAL_RING", _
    "IMPELLER_SEAL_RING", "INTERSTAGE_SEAL_RING", "MOTOR_SEAL_RING", _
    "MOTOR_SEAL_RING_WITH_PILOT", "MOTOR_SEAL_RING_WITH_PILOT_005"), Operator:= _
    xlFilterValues

Range("A:A,E:E,H:H,I:I").Select
Range("Table_WinSPCData.accdb[[#Headers],[VALUE_]]").Activate

Range("A:A,E:E,H:H,I:I,N:N").Select
Range("Table_WinSPCData.accdb[[#Headers],[TAG_VALUE]]").Activate
Selection.Copy
Sheets("1").Select
Range("A1").Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False

Dim i As Long
Dim Counter As Long

Dim Startdate As Date
Dim Enddate As Date
Dim Datadate As Date

Startdate = Worksheets("Date").Range("D2").Value
Enddate = Worksheets("Date").Range("D3").Value
Datadate = Worksheets("1").Cells(2 + i, 3).Value

Worksheets("1").Activate

For Counter = 0 To 11
For i = 0 To 2000

    If Cells(Counter + 2, 20).Value = Cells(2 + i, 5).Value And _
    Cells(Counter + 2, 22).Value = Cells(2 + i, 2).Value And _
    Cells(Counter + 2, 21).Value = Cells(2 + i, 1).Value And _
    Datadate >= Startdate And Datadate <= Enddate Then

        Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy Cells(2 + i, Counter + 8)

    End If

 Next i
 Next Counter

 End Sub

Data Sorting with an If Then statement not working

Answers (2)

Related Questions