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.