Good Morning,

I am looking for another option if available:

Because the data comes from some other source, it needs to be Cleaned & Trimmed before a VlookUp is done on a column.

The way I run "CleanTrim" is fine until the "workbook.name" is changed.

I have no control of what name this workbook would be saved as... a number of people will be using this workbook.

The 2 pieces of code are as below:


[vba]
Sub LookUpGroup()
Dim LastRow As Long

Application.ScreenUpdating = False

'clean GroupCodes column
Columns("A:A").Select
Application.Run "'SalesTargets.xls'!Clean_Trim" ‘ This is the line I am trying to workaround.

Columns("B:B").Insert Shift:=xlToRight
Range("B1").Value = "Group"
Columns("B:B").HorizontalAlignment = xlLeft

Range("B2").Activate
Range("B2").Formula = "=VLOOKUP($A$1:$A$60000,GroupCodes!$A:$C,3,0)"
If IsEmpty(ActiveCell) Then Exit Sub
Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown

With [A65536].End(xlUp).Offset(1).Resize(, [IV1].End(xlToLeft).Column)
.Formula = "=SUM(R2C:R[-1]C)"
.Value = .Value
.NumberFormat = "#,##0.00;[Red]#,##0.00"
.Font.Bold = True
.Interior.ColorIndex = 15
'In case Formulas are needed, comment out avobe code line.
End With
Sheets("Sales").Range("A65536").End(xlUp).Offset(0, 0).Value = ""
Sheets("Sales").Range("B65536").End(xlUp).Offset(0, 0).Value = "NetSales"

'Format Upper Table Borders
Dim r As Range
Set r = Range([B1], [B1].End(xlDown).End(xlToRight))
Borders r, xlThin
Set r = Nothing

'Lookup Formula as Values
Range("B1").Select
Range(Selection, Selection.End(xlDown)).Copy
Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

Columns("C:I").ColumnWidth = 11
Columns("A:B").EntireColumn.AutoFit

'FillTable

Range("A2").Select

Application.ScreenUpdating = True
End Sub

----------------------------------------------------------------------------------------

Sub CleanTrim()
Dim CleanTrimRg As Range
Dim oCell As Range
Dim Func As WorksheetFunction

Set Func = Application.WorksheetFunction

On Error Resume Next
Set CleanTrimRg = Selection.SpecialCells(xlCellTypeConstants, 2)
If Err Then MsgBox "No data to clean and Trim!": Exit Sub

For Each oCell In CleanTrimRg
oCell = Func.Clean(Func.Trim(oCell))
Next

End Sub
[/vba]

Thank you.... Carpiem