I get what i need, but other ideas to make it faster are welcome.
Sub P3D_Batch_SizeImpToMetric_table()
Dim fndList As Variant
Dim x As Long
Dim Source As Workbook
Dim Target As Range
Dim MyPath As String
Dim SizesRep As Range
Dim ws As Worksheet
Dim colNum As Integer
Dim rng As Range
Dim rng1 As Range
MyPath = "G:\88 - Plant 3D stuffs\LookupTable\" 'Change to suit
Sheets(1).Activate
' Start Macro to run for all worksheets "except Catalog Data"
For Each ws In Worksheets
Application.ScreenUpdating = False
If ws.Name <> "Catalog Data" Then
ws.Activate
' start copy Imperial Size column
Range("A2").Select
Set rng = Cells.Find(What:="Sizes", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
rng.Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
' end copy Imperial Size column
' start paste Imperial Size to Metric mmSize column
Range("A2").Select
Set rng = Cells.Find(What:="mmSize", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
rng.Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
' start paste Imperial Size to Metric mmSize column
' start Replace Imperial to Metric Size from NomDiaMap.xlsx
Set Target = Selection
On Error Resume Next
Set Source = Workbooks("NomDiaMap.xlsx") ' If open
If Not Source Is Nothing Then
fndList = Source.Sheets(1).Range("A:B").SpecialCells(2).Value
Else
Set Source = Workbooks.Open(MyPath & "Test_Translate.xlsm") 'If closed
fndList = Source.Sheets(1).Range("A:B").SpecialCells(2).Value
Source.Close False
End If
On Error GoTo 0
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
Target.Cells.Replace What:=fndList(x, 1), Replacement:=fndList(x, 2), _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next x
' end Replace Imperial to Metric Size
End If
Next ws
' Start Macro to run for all worksheets "except Catalog Data"
End Sub