Glad you got it working with your enhancments.

crystalgatewood wrote:

Dave - Thanks again, but I'd already figured something out (and I fixed
that text/date conversion problem as well):

Option Explicit
Sub testme()
Dim WksPOrig As Worksheet
Dim WksTemp As Worksheet
Dim WksPFinal As Worksheet
Dim WksTable As Worksheet
Dim myTableRng As Range
Dim myCell As Range
Dim holdCell As Range
Dim res As Variant
Dim LastRow As Long
Dim iRow As Long
Dim iCol As Long
Dim oRow As Long

Dim myArray() As Variant
Dim iCtr As Long
Dim maxFields As Long

maxFields = 100 '100 platforms in that cell??

ReDim myArray(1 To maxFields, 1 To 2)
For iCtr = 1 To maxFields
myArray(iCtr, 1) = iCtr
myArray(iCtr, 2) = 1
Next iCtr

'copy the original Platform sheet
Set WksPOrig = Worksheets("Sheet1")
WksPOrig.Copy _
after:=WksPOrig
Set WksTemp = ActiveSheet

Set WksTable = Worksheets("sheet2")

With WksTable
Set myTableRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

With WksTemp
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row

Range("D1").EntireColumn.Cut
Range("F1").EntireColumn.Insert Shift:=xlToRight

Range("E2", .Cells(.Rows.Count, "E").End(xlUp)) _
TextToColumns Destination:=.Range("E2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=True, Comma:=False, _
Space:=False, Other:=False, _
FieldInfo:=myArray

For Each myCell In myTableRng.Cells
With .Range("E2:IV" & LastRow)
Replace what:=myCell.Value, _
replacement:=myCell.Offset(0, 1).Value, _
lookat:=xlWhole, searchorder:=xlByRows, MatchCase:=False
End With
Next myCell

'create the final home for the data
Set WksPFinal = Worksheets.Add
WksPFinal.Range("a1").Resize(1, 5).Value _
= WksPOrig.Range("a1").Resize(1, 5).Value

oRow = 1
For iRow = 2 To LastRow
For iCol = 5 To .Cells(iRow, .Columns.Count).End(xlToLeft).Column
res = Application.Match(.Cells(iRow, iCol).Value, _
myTableRng.Offset(0, 1), 0)
If IsError(res) Then
'not found in Platform table
'not converted, just copy original row with Not Found message

oRow = oRow + 1
WksPFinal.Cells(oRow, "A").Resize(1, 3).Value _
= .Cells(iRow, "A").Resize(1, 3).Value
WksPFinal.Cells(oRow, "D").Value = "NOT FOUND (" & .Cells(iRow,
iCol).Value & ")"
WksPFinal.Cells(oRow, "E").Value = .Cells(iRow, "D").Value

Else
oRow = oRow + 1
WksPFinal.Cells(oRow, "B").NumberFormat = "@"
WksPFinal.Cells(oRow, "A").Resize(1, 3).Value _
= .Cells(iRow, "A").Resize(1, 3).Value
WksPFinal.Cells(oRow, "D").Value = .Cells(iRow, iCol).Value
WksPFinal.Cells(oRow, "E").Value = .Cells(iRow, "D").Value
End If
Next iCol
Next iRow
End With

Application.DisplayAlerts = False
WksTemp.Delete
Application.DisplayAlerts = True
End Sub

Thanks again for taking the time to help!

Crystal

--
crystalgatewood
------------------------------------------------------------------------
crystalgatewood's Profile: http://www.excelforum.com/member.php...o&userid=33477
View this thread: http://www.excelforum.com/showthread...hreadid=532789

--

Dave Peterson