Find & Replace - All worksheets except one and with different Target column

[rxk]

Hi ALL,

I have vba code below, stored on Workbook(cs-asmemetric1.xls) that works on a specific worksheet and column. But when I copied this exact code to my Personal.xlsb it has an error on "Set Target = ThisWorkbook.Sheets("PLUG, HEX HEAD").Columns(55)", I guess the function ThisWorkbook.Sheets is not applicable in Personal.xlsb

What I want to achieve:
1. Copy all imperial size in column B (starts from B3 to last value)
2. Paste copied imperial size to row 3 of column with name "mmSize". Column "mmSize" is not fix position.
If possible add a condition: do not paste if row 3 of column "mmSize" is not blank/empty
3. Replace imperial size value in column "mmSize" to metric size from lookup table NomDiaMap.xlsx
4. Column "mmSize" shall be number stored as text only
5. repeat steps 1-4, on all worksheets except "Catalog Data"

Thank you in advance.

regards,
rxk





Sub Multi_FindReplace()
Dim fndList As Variant
Dim x As Long
Dim Source As Workbook
Dim Target As Range
Dim MyPath As String

MyPath = "G:\88 - Plant 3D stuffs\LookupTable\" 'Change to suit

Set Target = ThisWorkbook.Sheets("PLUG, HEX HEAD").Columns(55)
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 Sub


27181
27182

[rxk]

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

[Paul_Hossler]

1.


ThisWorkbook.Sheets is not applicable in Personal.xlsb

ThisWorkbook refers to the WB containing the macro

ActiveWorkbook refers to the WB that is 'active'

2. Usually you don't need to .Select an object like a Range in order to act on it


Worksheets("Sheet1").Range("A1").Copy Worksheets("Sheet2").Range("Z26")