VBA identified Tables to compare values and skip if match
Page 4 of 4 FirstFirst ... 234
Results 31 to 33 of 33

Thread: VBA identified Tables to compare values and skip if match
Thanks Thanks: 0 Likes Likes: 0

  1. #31
    Board Regular
    Join Date
    Mar 2010
    Location
    New England
    Posts
    388
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA identified Tables to compare values and skip if match

    Last edited by DThib; Aug 2nd, 2019 at 07:57 AM.

  2. #32
    Board Regular
    Join Date
    Mar 2013
    Posts
    757
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA identified Tables to compare values and skip if match

    Does this work for you ?
    Code:
    Private Sub Move_CB_Click()
    ' revision_2 August 3, 2019
        Dim QAWs As Worksheet, QAr As Range, CKDate As Date
        Dim oLo As ListObject, oNewRow As ListRow
        
    Application.ScreenUpdating = False
    
    ON_Open.Hide
    CKDate = Sheets("Released Product").Range("K2").Value
    Set QAWs = Sheets("QA_Data")
    Set QAr = QAWs.ListObjects("QA_Table").ListColumns(3).DataBodyRange
    Set oLo = Sheets("Released Product").ListObjects("RP_Table")
    'add a row if the table has no rows
    If oLo.DataBodyRange Is Nothing Then oLo.ListRows.Add
    
    'loop thru QAr
    For Each cel In QAr
        'check the date and col H status
        If cel.Offset(, 7) = CKDate And cel.Offset(, 5) = 2 Then
            'check if already in RP_Table
            With oLo
                If WorksheetFunction.CountIfs(.ListColumns(4).DataBodyRange, cel.Value, .ListColumns(1).DataBodyRange, CKDate) = 0 Then
                    'need to add to RP_Table
                    Set oNewRow = .ListRows.Add
                    With oNewRow
                        .Range(1, 1) = CKDate
                        .Range(1, 2).Resize(, 6).Value = QAWs.Cells(cel.Row, 1).Resize(, 6).Value
                    End With
                End If
            End With
        End If
    Next cel
    
    'remove first table row if it's blank    'uncomment if you want this
    'If WorksheetFunction.CountA(oLo.ListRows(1).Range) = 0 Then oLo.ListRows(1).Delete
    
    Sheets("Released Product").Activate
    
    Application.ScreenUpdating = True
        
    End Sub

  3. #33
    Board Regular
    Join Date
    Mar 2010
    Location
    New England
    Posts
    388
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA identified Tables to compare values and skip if match

    Thanks, it worked.

    DThib

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •