I have a sheet with many columns and I would like to trim columns and formatting them based on headers. Below VBA works great before but somehow I got “Run-time Error -2147417848(80010108) Value of object range failed” now. Can anyone please help me to solve this error? If you have any other suggestions how to make the same function with different ways is appreciated too!
Sub A_BigOrder_S()
Dim src As Worksheet
Dim acell As Range, nf, v
Application.ScreenUpdating = False
ChDrive "C:"
strFileToOpen = Application.GetOpenFilename(Title:="Select Spreadsheet to Open")
Set src = ActiveSheet
For Each acell In src.Range("A1:JH1").Cells
nf = "" 'clear numberformat
v = UCase(Trim(acell.Value)) 'get the column header
Select Case True
Case v Like "ITEM ID*"
nf = "@"
src.Cells.EntireColumn.AutoFit
TrimSpaces acell.Offset(0)
Case v Like "GMC*"
nf = "@"
src.Cells.EntireColumn.AutoFit
TrimSpaces acell.Offset(0)
Case v Like "PL*"
nf = "@"
src.Columns(acell.Column).ColumnWidth = 4
TrimSpaces acell.Offset(0)
Case v Like "OEM*"
nf = "@"
src.Columns(acell.Column).ColumnWidth = 4
TrimSpaces acell.Offset(0)
Case v Like "*DATE": nf = "mm/dd/yy"
Case v Like "*PRICE*"
nf = "0.00"
src.Columns(acell.Column).ColumnWidth = 7.2
TrimSpaces acell.Offset(0)
Case v Like "*COST*"
nf = "0.00"
src.Columns(acell.Column).ColumnWidth = 7.2
TrimSpaces acell.Offset(0)
Case v Like "*Marg*"
nf = "0.00"
src.Columns(acell.Column).ColumnWidth = 7.2
TrimSpaces acell.Offset(0)
Case v Like "*PART*"
nf = "@"
src.Columns(acell.Column).ColumnWidth = 8.3
TrimSpaces acell.Offset(0)
Case v Like "VEN*"
nf = "@"
src.Columns(acell.Column).ColumnWidth = 4
TrimSpaces acell.Offset(0)
Case v Like "*CUFT*"
nf = "0.00"
src.Columns(acell.Column).ColumnWidth = 7.2
End Select
'any number format to apply?
If Len(nf) > 0 Then src.Columns(acell.Column).NumberFormat = nf
Next
Application.ScreenUpdating = True
DoEvents
End Sub
'Trim spaces from a column of data, starting at cell `B`
Function TrimSpaces(B As Range)
Dim cell As Range
For Each cell In B.Parent.Range(B, B.Parent.Cells(Rows.Count, B.Column).End(xlUp)).Cells
cell.Value = Trim(cell.Value)
If cell = "" Then
cell.ClearContents
ElseIf cell = 0 Then
cell.ClearContents
End If
Next cell
End Function
16
I see a few problems that might help
1. please use Option Explicit and declare all variables, and include type definitions
So:
Option Explicit
Sub A_BigOrder_S()
Dim src As Worksheet
Dim acell As Range, nf As String, v As String
Application.ScreenUpdating = False
ChDrive "C:"
Dim strFileToOpen As String
2. this code gets a file name, but doesn’t open the file:
strFileToOpen = Application.GetOpenFilename(Title:="Select Spreadsheet to Open")
Set src = ActiveSheet
strFileToOpen gets set with the selected file name
so scr may not be the worksheet that you think!
I suggest something like this:
Sub OpenFileDialog()
Dim filePath As String
Dim wbTarget As Workbook
Dim wsNew As Worksheet
filePath = Application.GetOpenFilename( _
FileFilter:="Excel and CSV Files (*.xls;*.xlsx;*.xlsm;*.csv),*.xls;*.xlsx;*.xlsm;*.csv", _
Title:="Select an Excel or CSV File")
If filePath <> "" Then
' Open the selected file in a new workbook
Set wbTarget = Workbooks.Open(filePath)
Set wsNew = ThisWorkbook.Worksheets.Add
wsNew.name = wsImportSheetname
' Copy data from the opened workbook to the new worksheet
wbTarget.Sheets(1).UsedRange.Copy wsNew.Range("A1")
' Close the opened workbook
wbTarget.Close False
Set wbTarget = Nothing
Set wsNew = Nothing
End If
End Sub
3. I’m not sure you need the .Offset(0) part. maybe pass the column number that you want to trim, instead of a range B. You defined a Function, but it should be a Sub, something like:
Sub TrimSpacesFromColumn(ws As Worksheet, columnNumber As Long)
Dim lastRow As Long
Dim cell As Range
' Find the last row with data in the specified column
lastRow = ws.Cells(ws.Rows.Count, columnNumber).End(xlUp).Row
' Loop through each cell in the specified column
For Each cell In ws.Range(ws.Cells(1, columnNumber), ws.Cells(lastRow, columnNumber))
If Not IsEmpty(cell.Value) Then
' Trim spaces from the cell's value
cell.Value = Application.Trim(cell.Value)
End If
Next cell
End Sub
and then you could call it like:
TrimSpaces src, acell.Column
Please note that I haven’t tested this code… just some ideas I hoped would help