Search a word table for a unique value and delete in second table if not present

[atuck88]

I have two tables in Word.


One table contains laboratory data and its corresponding analytical method code/value in column one.


The second table (which lists the accredited methods used) has the method code/value in column two.


I need the VBA code so it searches the second column in table two and if it is not present in table one (column one), delete the row from table two.


The method codes generally consist of things like; INORG-L01, METALS-L, ORG-L1.

The code so far consist of:

If Selection.Information(wdWithInTable) = FalseThen    MsgBox ("Put cursor inside a table first!")
    Exit Sub
Else
    With Selection.Tables(1)
        nRows = .Rows.Count
        For nRowIndex = nRows To 1 Step -1
            varCellEmpty = True
            For nColumns = 2 To .Columns.Count
                Set objCell = .Rows(nRowIndex).Cells(nColumns).Range
                objCell.End = objCell.End - 1
                If Len(objCell) > 0 And Not objCell.Text = "-" Then
                    varCellEmpty = False
                    Exit For
                End If
            Next nColumns
            If varCellEmpty = True Then .Rows(nRowIndex).Delete
        Next nRowIndex
    End With
End If
Set objCell = Nothing 
Application.ScreenUpdating = True

This can search through tables and delete the rows (when "-" is replaced with the method codes) but I don’t know how to get it to work like that described above. I’m a bit lost…

[gmayor]

I think the following is what you are looking for:

Sub Macro1()
Dim oTable1 As Table, oTable2 As Table
Dim nRows As Long, mRows As Long
Dim objCell As Range, oRng As Range
Dim bDel As Boolean
    Set oTable1 = ActiveDocument.Tables(1)
    Set oTable2 = ActiveDocument.Tables(2)
    With oTable2
        For nRows = .Rows.Count To 1 Step -1
            Set objCell = .Rows(nRows).Cells(2).Range
            objCell.End = objCell.End - 1
            If Len(objCell) > 0 And Not objCell.Text = "-" Then
                bDel = False
                For mRows = 1 To oTable1.Rows.Count
                    Set oRng = oTable1.Rows(mRows).Cells(1).Range
                    oRng.End = oRng.End - 1
                    If oRng.Text = objCell.Text Then
                        bDel = True
                        Exit For
                    End If
                Next mRows
            End If
            If bDel = False Then .Rows(nRows).Delete
        Next nRows
    End With
lbl_Exit:
    Set oTable1 = Nothing
    Set oTable2 = Nothing
    Set objCell = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

[atuck88]

You Sir are a legend! and can code better than I ever could.

Thank you so much. This is amazing.