I know that it is strange to ask this question. But what I came across is no less strange.
I have a few long lines (about 1000 characters or more - update: sorry, not 1000, but about 39000, my bad). They contain spaces that I want to trim.
Acting with common sense, I used Worksheetfunction.Trimto complete the assignment. It worked with a short string (about 500 characters). However, as the string grew (over 39,000 characters), it returned an error'1004' - unable to get trim property of the worksheetfunction class
In doubt, I performed several tests with a long line on the sheet. I entered a dummy string like "aaaaaabbbbbbbcccc ..." in a cell and =TRIM(string)in another cell. It works. How it works on a sheet, but not in VBA. I'm confused.
To do this work, I made my own TRIM function as a workaround. But I still want to know what happens to Worksheetfunction.Trim. What is the limit Worksheetfunction.Trim?
Any help is appreciated. :)
Here is my code:
I use the following functions::
get_address(wks as worksheet) as stringget the address of all ranges containing data in the form of a constant and formula.
EXNUM(TextIn as string, optional separator as string = " ") as string: remove all non-numeric characters from a string
First I get the range address with the address get_address, then EXNUM. Then I ran Worksheetfunction.Trimin EXNUM result
Function get_address(wks As Worksheet) As String
'***Find the range***
Dim rs1 As range, rs2 As range
On Error Resume Next
Set rs1 = wks.Cells.SpecialCells(xlCellTypeConstants)
If Err.Number <> 0 Then
Set rs1 = Nothing
End If
Set rs2 = wks.Cells.SpecialCells(xlCellTypeFormulas)
If Err.Number <> 0 Then
Set rs2 = Nothing
End If
'***Extract range address***
Dim ad1 As String, ad2 As String
Dim result As String
ad1 = area_address(rs1)
ad2 = area_address(rs2)
result = ad1 & "," & ad2
If Right(result, 1) = "," Then
result = Left(result, Len(result) - 1)
End If
get_address = result
End Function
Function EXNUM(TextIn As String, _
Optional separator As String = " ") As String
Dim x As Double
Dim result As String
For x = 1 To Len(TextIn)
If Not IsNumeric(Mid(TextIn, x, 1)) Then
result = result + separator
Else
result = result + Mid(TextIn, x, 1)
End If
Next x
If Len(result) >= 1 And Right(result, 1) = separator Then
result = Left(result, Len(result) - 1)
End If
EXNUM = result
End Function
'**********Supporting function only************
Public Function area_address(r As range) As String
Dim x As Double
Dim result As String
For x = 1 To r.Areas.count
result = result + r.Areas.Item(x).address(rowabsolute:=False, columnabsolute:=False) + ","
Next x
If Right(result, 1) = "," Then
result = Left(result, Len(result) - 1)
End If
'Debug.Print r.Areas.count
area_address = result
End Function
Here is a screenshot of the error and len lines
UPDATE: @brettdj: this is what I work for. This is a pretty simple idea. I want to create a DetectSizeX function. If I enter a worksheet or range, DetectSizeX will return a smaller range address containing all the data in the larger range / worksheet.
: DetectSizeX(Activesheet) == > return "A3:T3568"
:
1: , :
Cells.SpecialCells(xlCellTypeConstants)
Cells.SpecialCells(xlCellTypeConstants)
2: , . . r_address.
r_address "A1, B33: C88, T6: Z90, K7: Z100..."
3: top-left bot-right cells
r_address .
r_address .
" " (, A, B, AA, AZ) r_address
r_address .
Concatenate(smallest col name, smallest number)
Concatenate(largest col name, largest number)
, DetectSizeX
, , :
:)
'====================================
'**********Detectsize V6*************
'====================================
Public Function DetectSizeX_v6(WorkSheetIn As Worksheet, Optional r_ad As String = vbNullString) As String
'**Note: if DetectSizeX_v5 return a string "0", it means an error, should skip that worksheet
Dim address As String
Dim top_left As String
Dim bot_right As String
Dim max_row As Double
Dim min_num As Double
Dim max_col As String
Dim min_col As String
If r_ad = vbNullString Then
address = get_address(WorkSheetIn)
Else
address = get_address_range(WorkSheetIn, r_ad)
End If
If Len(address) > 0 Then
max_row = get_row(address, True)
min_num = get_row(address, False)
max_col = get_col_name(address, True)
min_col = get_col_name(address, False)
top_left = min_col & min_num
bot_right = max_col & max_row
DetectSizeX_v6 = top_left & ":" & bot_right
Else
DetectSizeX_v6 = "0"
End If
End Function
'*************GET_ADDRESS HERE*********************
Public Function get_address(wks As Worksheet) As String
'***Find the range***
Dim rs1 As range, rs2 As range
On Error Resume Next
Set rs1 = wks.Cells.SpecialCells(xlCellTypeConstants)
If Err.Number <> 0 Then
Set rs1 = Nothing
End If
Set rs2 = wks.Cells.SpecialCells(xlCellTypeFormulas)
If Err.Number <> 0 Then
Set rs2 = Nothing
End If
'***Extract range address***
Dim ad1 As String, ad2 As String
Dim result As String
ad1 = area_address(rs1)
ad2 = area_address(rs2)
result = ad1 & "," & ad2
If Right(result, 1) = "," Then
result = Left(result, Len(result) - 1)
End If
get_address = result
End Function
Public Function area_address(r As range) As String
Dim x As Double
Dim result As String
For x = 1 To r.Areas.count
result = result + r.Areas.Item(x).address(rowabsolute:=False, columnabsolute:=False) + ","
Next x
If Right(result, 1) = "," Then
result = Left(result, Len(result) - 1)
End If
area_address = result
End Function
Public Function get_address_range(wks As Worksheet, r_ad As String) As String
'***Find the range***
Dim rs1 As range, rs2 As range
On Error Resume Next
Set rs1 = wks.range(r_ad).SpecialCells(xlCellTypeConstants)
If Err.Number <> 0 Then
Set rs1 = Nothing
End If
Set rs2 = wks.range(r_ad).SpecialCells(xlCellTypeFormulas)
If Err.Number <> 0 Then
Set rs2 = Nothing
End If
'***Extract range address***
Dim ad1 As String, ad2 As String
Dim result As String
ad1 = rs1.address(rowabsolute:=False, columnabsolute:=False)
ad2 = rs2.address(rowabsolute:=False, columnabsolute:=False)
result = ad1 + "," + ad2
If Right(result, 1) = "," Then
result = Left(result, Len(result) - 1)
End If
get_address_range = result
End Function
'******SUPPORTING FUNCTION*******
'*********For DetectSizeX_v6*****
Public Function get_col_name(ByVal address As String, max_min As Boolean)
'****Extract column name from address + cleaning address****
'address = "D2: D7 , G8, B2: B9 , F7: F9 , C2: C10 , E2: E13 , B13: D13"
'Note: if get_col_name return string "0", it means an error
address = EXTEXT(address)
address = Replace(address, ",", " ")
address = Replace(address, ":", " ")
address = EXNONBLANK(address)
'***Split address into individual string***
Dim arr() As String
arr = Split(address, " ")
'***Convert column names into index***
Dim x As Double
Dim arr_size As Double
Dim arr_num() As Double
arr_size = UBound(arr)
ReDim arr_num(0 To arr_size)
For x = 0 To arr_size
arr_num(x) = col_num(arr(x))
Next x
'***Extract the max and the min col name/char***
Dim temp_num As Double
Dim max_char As String
Dim min_char As String
'***Max:
temp_num = Application.WorksheetFunction.Max(arr_num)
For x = 0 To arr_size
If arr_num(x) = temp_num Then
Exit For
End If
Next x
max_char = arr(x)
'***Min:
temp_num = Application.WorksheetFunction.Min(arr_num)
For x = 0 To arr_size
If arr_num(x) = temp_num Then
Exit For
End If
Next x
min_char = arr(x)
'***Return value***
If max_min Then
get_col_name = max_char
Else
get_col_name = min_char
End If
End Function
Public Function get_row(ByRef address As String, max_min As Boolean)
Dim x As Double
Dim max_ad As String, min_ad As String
Dim max_row As Double, min_row As Double
For x = Len(address) To 1 Step -1
If Mid(address, x, 1) = "," Then
max_ad = Right(address, Len(address) - x)
Exit For
End If
Next x
For x = 1 To Len(address)
If Mid(address, x, 1) = "," Then
min_ad = Left(address, x - 1)
Exit For
End If
Next x
max_ad = EXNONBLANK(EXNUM(max_ad))
min_ad = EXNONBLANK(EXNUM(min_ad))
'***get_max_min
Dim arr() As String
Dim arr_val() As Double
Dim arr_size As Double
arr = Split(max_ad + " " + min_ad, " ")
arr_size = UBound(arr, 1)
ReDim arr_val(0 To arr_size)
For x = 0 To UBound(arr, 1)
arr_val(x) = Val(arr(x))
Next x
max_row = Application.WorksheetFunction.Max(arr_val)
min_row = Application.WorksheetFunction.Min(arr_val)
If max_min Then
get_row = max_row
Else
get_row = min_row
End If
End Function
Public Function EXTEXT(TextIn As String, _
Optional separator As String = " ") As String
Dim x As Double 'for long text
Dim result As String
For x = 1 To Len(TextIn)
If IsNumeric(Mid(TextIn, x, 1)) Then
result = result + separator
Else
result = result + Mid(TextIn, x, 1) + separator
End If
Next x
If Len(result) >= 1 And Right(result, 1) = separator Then
result = Left(result, Len(result) - 1)
End If
EXTEXT = result
End Function
Public Function EXNUM(TextIn As String, _
Optional separator As String = " ") As String
Dim x As Double
Dim result As String
For x = 1 To Len(TextIn)
If Not IsNumeric(Mid(TextIn, x, 1)) Then
result = result + separator
Else
result = result + Mid(TextIn, x, 1)
End If
Next x
If Len(result) >= 1 And Right(result, 1) = separator Then
result = Left(result, Len(result) - 1)
End If
EXNUM = result
End Function
'***Convert col_name to col_number
Public Function col_num(col_name As String)
col_num = range(col_name & 1).Column
End Function
'***End Convert col_name to col_number
Function EXNONBLANK(str As String) As String
Do While InStr(str, " ") > 0
str = Replace$(str, " ", " ")
Loop
EXNONBLANK = trim$(str)
End Function
'====================================
'**********End Detectsize V6*********
'====================================