If statements return too many values

Question

New to VBA

I am trying to create a sub that will return certification expiration dates. I am pulling the data from a table, and copying the answer to a range. I am using comboboxes so you can just pick from multiple choices.

However, When i choose certain combo boxes, there must be some overlap and I get too many values. Any thoughts or help is greatly appreciated.

Sub tblcopypast()

Dim Month As String
Dim tbl As ListObject
Dim iCt As Integer
Dim jCt As Integer
Dim lastrow As Integer
Dim targetRange As Range
Dim actRange As Range
Dim Year As String
Dim Certs As String

Worksheets("Search").Range("Newrng").ClearContents

    Set tbl = Sheet1.ListObjects("Table1")
    Month = Worksheets("Search").Month
    Year = Worksheets("Search").Year
    Certs = Worksheets("Search").cbCerts
    lastrow = tbl.ListRows.Count
    jCt = 0

    Set targetRange = Worksheets("Search").Range("newrng").End(xlUp).Offset(1, 0)

    For iCt = 1 To lastrow
        If tbl.DataBodyRange(iCt, 3) = Month And tbl.DataBodyRange(iCt, 2) = Certs And tbl.DataBodyRange(iCt, 4) = Year Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
        If tbl.DataBodyRange(iCt, 6) = Month And tbl.DataBodyRange(iCt, 5) = Certs And tbl.DataBodyRange(iCt, 7) = Year Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
        If tbl.DataBodyRange(iCt, 8) = Certs And tbl.DataBodyRange(iCt, 9) = Month And tbl.DataBodyRange(iCt, 10) = Year Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
        If tbl.DataBodyRange(iCt, 3) = Month And tbl.DataBodyRange(iCt, 4) = Year Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
        If tbl.DataBodyRange(iCt, 6) = Month And tbl.DataBodyRange(iCt, 7) = Year Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
        If tbl.DataBodyRange(iCt, 9) = Month And tbl.DataBodyRange(iCt, 10) = Year Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
        If tbl.DataBodyRange(iCt, 2) = Certs And tbl.DataBodyRange(iCt, 4) = Year Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
        If tbl.DataBodyRange(iCt, 5) = Certs And tbl.DataBodyRange(iCt, 7) = Year Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
        If tbl.DataBodyRange(iCt, 8) = Certs And tbl.DataBodyRange(iCt, 10) = Year Then
            tbl.ListRows(iCt).Range.Copy
            targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
            jCt = jCt + 1
        End If
    Next

    Range("Newrng").HorizontalAlignment = xlCenter
    Range("Newrng").VerticalAlignment = xlBottom
    Worksheets("Search").Columns("F:P").AutoFit


    Worksheets("Search").Month.Value = Null
    Worksheets("Search").Year.Value = Null
    Worksheets("Search").cbCerts.Value = Null


End Sub

Your looser If blocks will match lines matched (and copied) by previous tests: why test some lines for (eg) Certs but then repeat the test without that part? — Tim Williams, Feb 25 '19 at 02:18
What are the crieria for matching a record? Month+Year+Cert, or any two of those? — Tim Williams, Feb 25 '19 at 02:24
Thanks for your reply! I want user to be able to search certifications, by month, year or a combination. My goal was to also allow users to search by just months or year. — Frank L., Feb 25 '19 at 02:52
So the user wouldn't pick a cert if they just want month&year? How would you know how they want to search? — Tim Williams, Feb 25 '19 at 03:00
My thinking was you might want to know all certifications expiring in a month or year. What do you think is a better approach? Ultimately, I want to be able to send an email from the results with a button. — Frank L., Feb 25 '19 at 03:03
Note that all your row counting variables **must** be of type `Long` because Excel has more rows than `Integer` can handle. I recommend [always to use Long instead of Integer](https://stackoverflow.com/a/26409520/3219613) in VBA since there is no benefit in `Integer` at all. — Pᴇʜ, Feb 25 '19 at 09:26

Tim Williams · Accepted Answer · 2019-02-26T06:52:48.520

Untested but this may do what you need. It only checks for a match if a search value has been selected.

Sub tblcopypast()

Dim Month As String
Dim tbl As ListObject
Dim iCt As Long
Dim jCt As Long
Dim lastrow As Long
Dim targetRange As Range
Dim actRange As Range
Dim Year As String
Dim Certs As String
Dim c As Long, rYear, rMonth, rCert

    Worksheets("Search").Range("Newrng").ClearContents

    Set tbl = Sheet1.ListObjects("Table1")
    Month = Worksheets("Search").Month
    Year = Worksheets("Search").Year
    Certs = Worksheets("Search").cbCerts
    lastrow = tbl.ListRows.Count
    jCt = 0

    Set targetRange = Worksheets("Search").Range("newrng").End(xlUp).Offset(1, 0)

    For iCt = 1 To lastrow

        For c = 0 To 6 Step 3 '<< use a loop to go over the row

            rYear = tbl.DataBodyRange(iCt, 4 + c)
            rMonth = tbl.DataBodyRange(iCt, 3 + c)
            rCert = tbl.DataBodyRange(iCt, 2 + c)

            If (Month = "" Or rMonth = Month) And _
               (Certs = "" Or rCert = Certs) And _
               (Year = "" Or rYear = Year) Then
                tbl.ListRows(iCt).Range.Copy
                targetRange.Offset(jCt, 0).PasteSpecial xlPasteValues
                jCt = jCt + 1
                Exit For  '<< stop checking this row
            End If

        Next c

    Next

    Range("Newrng").HorizontalAlignment = xlCenter
    Range("Newrng").VerticalAlignment = xlBottom
    Worksheets("Search").Columns("F:P").AutoFit

    Worksheets("Search").Month.Value = Null
    Worksheets("Search").Year.Value = Null
    Worksheets("Search").cbCerts.Value = Null


End Sub

Note that all row counting variables **must** be of type `Long` because Excel has more rows than `Integer` can handle. I recommend [always to use Long instead of Integer](https://stackoverflow.com/a/26409520/3219613) in VBA since there is no benefit in `Integer` at all. — Pᴇʜ, Feb 25 '19 at 09:26
Thanks for the reply! The double look concept is new to me, but I am viewing problems differently with it! I will definitely use Long for row variables. — Frank L., Feb 25 '19 at 15:48

If statements return too many values

1 Answers1