Page 3 of 4 FirstFirst 1234 LastLast
Results 21 to 30 of 33

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

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

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

    Hi No Spark,
    The workbook we were discussing.

    I have data being added to the 2 worksheets (MB51_Draw) and COOIS_Draw) as part of this workbook.
    The Userform Add button. Starts running through code and gives me 23 results in the QA_Table.
    The remaining results that also meet the 2 criteria are not being pulled.

    This may be because the COOIS_Draw sheet will have the Batch ID once. The MB51_Draw sheet will have the matching ID several times and not in the next row down. I think the macro as written is finding the first instance and then not looking further down to the matching Id that will also fulfill the second criteria( column,row for number starting with 5). I am not getting the expected results from a workbook that is going to have information added to the 2 worksheets (MB51_Draw) and COOIS_Draw) that will need to evaluate all entries.

  2. #22
    Board Regular
    Join Date
    Mar 2010
    Location
    New England
    Posts
    414
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    I have removed the second criteria and I get the first result for each but not the row that should also contain a column for the 500000000 number

  3. #23
    Board Regular
    Join Date
    Mar 2013
    Posts
    798
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    0 Thread(s)

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

    You're right, I didn't consider the necessity of looking further down the column once the first instance was found.
    Give this a try
    Code:
    Sub Newt()
    'revision 3 July 26, 2019 1:39 PM PDT
        Dim Coos As Worksheet, MBs As Worksheet, QAWs As Worksheet
        Dim COr As Range, MBr As Range
        Dim cel As Range, fndRng As Range, firstAddress As String
        Dim tbL As ListObject, oNewRow As ListRow
    
    
    'set the worksheets
        Set MBs = ThisWorkbook.Sheets("MB51_Draw")
        Set Coos = ThisWorkbook.Sheets("COOIS_Draw")
        Set QAWs = ThisWorkbook.Sheets("QA_Data")
    
    
    'set ranges and table
        With Coos
           Set COr = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        End With
        
        With MBs
            Set MBr = .Range("M:M")
        End With
            
        With QAWs
           Set tbL = .ListObjects(1)    'first table on sheet
        End With
        
    Application.ScreenUpdating = False
    
    
    'check if value in COr (order) exists in MBr (batch)
    For Each cel In COr
        Set fndRng = MBr.Find(What:=cel.Value, LookIn:=xlValues, LookAt:=xlWhole, _
                              SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            
        If Not fndRng Is Nothing Then   'meaning it was found
            firstAddress = fndRng.Address
            Do
                'look back into MB51_Draw to (Material Document) for a number starting with 5
                If Left(fndRng.Offset(, -1).Value, 1) = 5 Then
                    'check if already in table tbL
                    With tbL
                        If WorksheetFunction.CountIf(.ListColumns(3).DataBodyRange, cel.Value) = 0 Then
                            'not found so add to the table
                            Set oNewRow = .ListRows.Add
                            With oNewRow.Range
                                .Cells(1, 1) = cel.Offset(, 3).Value            'Coos.Cells(m, 4).Value
                                .Cells(1, 2) = cel.Offset(, 4).Value            'Coos.Cells(m, 5).Value
                                .Cells(1, 6) = cel.Offset(, 12).Value           'Coos.Cells(m, 13).Value
                                .Cells(1, 3) = fndRng.Value                     'MBs.Cells(g, 13).Value
                                .Cells(1, 4) = fndRng.Offset(, 4).Value         'MBs.Cells(g, 17).Value
                                .Cells(1, 5) = fndRng.Offset(, 1).Value         'MBs.Cells(g, 14).Value
                            End With
                        End If
                    End With
                End If
                'look further down the column
                Set fndRng = MBr.FindNext(fndRng)
            Loop While Not fndRng Is Nothing And fndRng.Address <> firstAddress
        End If
    Next cel
        
    Application.ScreenUpdating = True
    
    
    MsgBox "The data has been evaluated", vbInformation + vbOKOnly, "QA Sterilized Package Movement"
       
    End Sub

  4. #24
    Board Regular
    Join Date
    Mar 2010
    Location
    New England
    Posts
    414
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    Thank you, that worked!


    I appreciate your help, greatly!

    DThb

  5. #25
    Board Regular
    Join Date
    Mar 2010
    Location
    New England
    Posts
    414
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    Now another wrinkle,
    The data may be pulled more than once a day.
    The user wants to limit the data place with the macro above by having it only take data for today and place in the worksheet, but make sure they do not pull data twice if the batch number already in the list for today.
    Code to this point is below, I have tried adapting the solution you gave with no luck.

    Code:
    Private Sub Move_CB_Click()
    
    
      Dim RPWs, QAWs As Worksheet
      Dim FirstW As Long
      Dim SecondW As Long
      Dim j, k As Long
      Dim CKDate As Date
      Dim RPr, cel As Range
        
        ON_Open.Hide
        CKDate = Sheets("Released Product").Range("K2").Value
        
       Set QAWs = Sheets("QA_Data")
       With QAWs
         Set QAr = .Range("C2", .Range("C" & .Rows.Count).End(xlUp))
       End With
       Set RPWs = Sheets("Released Product")
       With RPWs
         Set RPr = .Range("D:D")
       End With
        SecondW = Sheets("QA_Data").Cells(Rows.Count, "B").End(xlUp).Row
        FirstW = Sheets("Released Product").Cells(Rows.Count, "B").End(xlUp).Row
        
       For Each cel In RPr
        Set fndRng = QAr.Find(What:=cel.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, MatchCase:=False)
         If Not fndRng Is Nothing Then
            firstAddress = fndRng.Address
            Do
                k = 1 + SecondW
                j = FirstW
                 For k = 1 To SecondW
                   If QAWs.Cells(k, 10) = CKDate And QAWs.Cells(k, 8) = 2 Then
                       Sheets("Released Product").Cells(j, 1) = CKDate
                       Sheets("Released Product").Cells(j, 2) = QAWs.Cells(k, 1).Value
                       Sheets("Released Product").Cells(j, 3) = QAWs.Cells(k, 2).Value
                       Sheets("Released Product").Cells(j, 4) = QAWs.Cells(k, 3).Value
                       Sheets("Released Product").Cells(j, 5) = QAWs.Cells(k, 4).Value
                       Sheets("Released Product").Cells(j, 6) = QAWs.Cells(k, 5).Value
                       Sheets("Released Product").Cells(j, 7) = QAWs.Cells(k, 6).Value
                      j = j + 1
                   End If
                 Next k
                Set fndRng = RPr.FindNext(fndRng)
            Loop While Not fndRng Is Nothing And fndRng.Address <> firstAddress
         End If
       Next cel
        MsgBox "The data has been moved", vbInformation + vbOKOnly, "QA Sterilized Package       Movement"
             
    End Sub
    Help?!

  6. #26
    Board Regular
    Join Date
    Mar 2010
    Location
    New England
    Posts
    414
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    To better explain, hopefully, the data from the worksheet will be processed and those results will be parsed by this macro.
    The macro uses these criteria to define the results to be added to the "Released Product" worksheet. The data may get pulled more than once a day.
    If the data is run again, I need to make sure the data already analyzed and copied is not recopied but rather skipped. I have spent 2 days trying to figure out how to finesse this.

    No luck,

    DThib

  7. #27
    Board Regular
    Join Date
    Mar 2013
    Posts
    798
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    0 Thread(s)

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

    Sorry, you've lost me again.

    The file you supplied doesn't have a "Released Product" sheet
    and don't know what constitutes 'list for today'.

    If the data is run again, I need to make sure the data already analyzed and copied is not recopied but rather skipped. I have spent 2 days trying to figure out how to finesse this.
    by chance does (manually) using Excels built in Remove Duplicates function on the Table Tools ribbon produce what you're after ?

  8. #28
    Board Regular
    Join Date
    Mar 2010
    Location
    New England
    Posts
    414
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    In the file (Sheets("Released Product") is in the file.
    In any event,

    the worksheet(""Released Product") is the landing page for the macro.
    The workbook uses worksheet("QA_Data") to provide the data from your first code help.
    The user confirms all information is complete by adding a "c" to a column. This generates a conditional response that gives a 2 in another column and turns the row green.

    The code drops the information from the current date and the number 2 appearing into the worksheet(""Released Product").

    I'll highlight the code for you.

    Code:
    Private Sub Move_CB_Click()
    
    
      Dim RPWs, QAWs As Worksheet
      Dim FirstW As Long
      Dim SecondW As Long
      Dim j, k As Long
      Dim CKDate As Date
      Dim RPr, cel As Range
        
        ON_Open.Hide
        CKDate = Sheets("Released Product").Range("K2").Value
        
       Set QAWs = Sheets("QA_Data")
       With QAWs
         Set QAr = .Range("C2", .Range("C" & .Rows.Count).End(xlUp))
       End With
       Set RPWs = Sheets("Released Product")
       With RPWs
         Set RPr = .Range("D:D")
       End With
        SecondW = Sheets("QA_Data").Cells(Rows.Count, "B").End(xlUp).Row
        FirstW = Sheets("Released Product").Cells(Rows.Count, "B").End(xlUp).Row
        
       For Each cel In RPr
        Set fndRng = QAr.Find(What:=cel.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, MatchCase:=False)
         If Not fndRng Is Nothing Then
            firstAddress = fndRng.Address
            Do
                k = 1 + SecondW
                j = FirstW
                 For k = 1 To SecondW
                   If QAWs.Cells(k, 10) = CKDate And QAWs.Cells(k, 8) = 2 Then
                       Sheets("Released Product").Cells(j, 1) = CKDate
                       Sheets("Released Product").Cells(j, 2) = QAWs.Cells(k, 1).Value
                       Sheets("Released Product").Cells(j, 3) = QAWs.Cells(k, 2).Value
                       Sheets("Released Product").Cells(j, 4) = QAWs.Cells(k, 3).Value
                       Sheets("Released Product").Cells(j, 5) = QAWs.Cells(k, 4).Value
                       Sheets("Released Product").Cells(j, 6) = QAWs.Cells(k, 5).Value
                       Sheets("Released Product").Cells(j, 7) = QAWs.Cells(k, 6).Value
                      j = j + 1
                   End If
                 Next k
                Set fndRng = RPr.FindNext(fndRng)
            Loop While Not fndRng Is Nothing And fndRng.Address <> firstAddress
         End If
       Next cel
        MsgBox "The data has been moved", vbInformation + vbOKOnly, "QA Sterilized Package       Movement"
             
    End Sub
    All sheet references to released product highlighted in red.

    DThib

  9. #29
    Board Regular
    Join Date
    Mar 2013
    Posts
    798
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    0 Thread(s)

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

    So that we're both dealing with the same thing,
    will you please download the file you link to in post 13 and let me know where to find
    Sheets("Released Product") and what you are referring to as the list for today.


    Thanks

  10. #30
    Board Regular
    Join Date
    Mar 2010
    Location
    New England
    Posts
    414
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    Ok, in a few minutes.

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
  •