Carpiem
07-11-2006, 09:14 AM
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:
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
Thank you.... Carpiem
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:
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
Thank you.... Carpiem