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

I would start by cleaning up the selects: http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros — puzzlepiece87, Aug 18 '16 at 15:54
@puzzlepiece87 Can I delete the `ActiveWindow.ScollColumn` lines. are they used or are they just scrap from my recorded stuff. Are there any lines I can delete because they do stuff that is irrelevant to the code. — Keizzerweiss, Aug 18 '16 at 16:01
Yes, you can delete the `ActiveWindow.ScrollColumn` lines. No comment on the rest until all the `.Select ` and `Selection` has been fixed because it's not worth nitpicking until the big problem has been solved. — puzzlepiece87, Aug 18 '16 at 16:22
Still reading but at the bottom, it may be more efficient code-wise to change your `Then If`s to `And`s. `Then If` is more useful if you'll do something even if the second condition fails. — puzzlepiece87, Aug 18 '16 at 16:45
Thank you for cleaning up your code - it helped a lot. Can you do a debug: Where your code says `Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy`, add another command `Msgbox Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Address`. Then you will be able to tell if the right data is being copied. — puzzlepiece87, Aug 18 '16 at 16:51
It sends back `$D$2` which is correct, but it can only paste that cell if the other stuff matches up. Otherwise it should look for a match in the next Row's data. My code failed at `Criteria1paste.PasteSpecial xlPasteValues` — Keizzerweiss, Aug 18 '16 at 16:58
@puzzlepiece87 i'm off to lunch, but I'll be back. Thank you so much for helping. — Keizzerweiss, Aug 18 '16 at 17:04

puzzlepiece87 · Answer 1 · 2016-08-18T19:10:27.653

1

Thank you again for cleaning up your code and helping to debug it.

Your problem lies in the way that you are using If/Then/Else code lines.

You need to change this style:

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

to this style:

If AssetRight1 = AssetLeft1 And _
VariablenameRight1 = VariablenameLeft1 And _ 
PartnameRight1 = PartnameLeft1 And _ 
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
End If

Specifically, you were making the mistake of putting a Then action on the same line as the If conditions when you had multiple actions to do (Copy, Paste, etc.). If you put a Then action on the same line as an If condition, VBA assumes that the If/Then/Else ends on that line. Therefore, VBA was always running your paste code regardless of whether the If conditions passed or not.

The other changes I made (switching If Thens to Ands, using Copy Destination rather than Copy Paste) are optional.

edited Aug 18 '16 at 19:10

answered Aug 18 '16 at 17:09

puzzlepiece87

1,537
2
19
36

Interesting. VBA doesn't like the Format. It says it `Expects an Expression` on the Error Message. I tried messing with it a little but it doesn't seem to work. – Keizzerweiss Aug 18 '16 at 17:49
@Keizzerweiss Sorry, I accidentally left extra `If`s in there, I only took out the `Then`s. I corrected the second block of code. – puzzlepiece87 Aug 18 '16 at 17:54
now it has a problem with my `For` `Next` Commands. It says that there is no `For` for the `Next`. See my main post for a code update. Not enough space to put it down here. – Keizzerweiss Aug 18 '16 at 18:07
Should be there now. – Keizzerweiss Aug 18 '16 at 18:10
@Keizzerweiss Another error by me, I corrected them to multiline `If/Then/Else`s but forgot to put End If. See (again) corrected second code section. VBA gave you that error because it is trapped in the `If/Then/Else` clause and can't "see" the `For` on the outside until you escape back to that level of the code again by saying `End If` – puzzlepiece87 Aug 18 '16 at 19:09
Okay so it loops now and runs but it doesn't put any values in the `criteria#paste` ranges. I would Assume something is up with my date Boolean. I think the loop is working it is just not able to find anything. I widened the dates and still nothing. Do you see anything wrong with it. I converted the dates to the number format, so I would hope that would not be the case. – Keizzerweiss Aug 18 '16 at 20:38
1

@Keizzerweiss Can you either: 1. Read up on `DateSerial` and implement that or 2. Debug using a separate `If/Then` line with your date condition and msgbox to confirm that's the problem? I'm happy to help if you need more help after that. Use F8 to step through your code if needed after implementing option 2. – puzzlepiece87 Aug 18 '16 at 21:13
Okay I'll pull it apart tomorrow. Thanks for all the help. I'll update my post as things happen. – Keizzerweiss Aug 18 '16 at 22:05
1

I got it, I'll post my answer. Thanks for all your help I couldn't have done this without it. – Keizzerweiss Aug 22 '16 at 16:07

score 0 · Accepted Answer · answered Aug 22 '16 at 16:15

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

For the sake of all who will maintain your code in the future, and for your own sake, please follow puzzlepiece's advice and eliminate your usage of `select` (http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) — n8., Sep 29 '16 at 17:25

Data Sorting with an If Then statement not working

2 Answers2