rxk
09-22-2020, 09:18 PM
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
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