VBA, Parsing a specific column with different delimiters.

mdo8105

Board Regular
Joined
Nov 13, 2015
Messages
83
I have written a script, that when I select the column, and hit Ctrl + Shift + S, it will ask me for a delimiter, then based off that it will split the column, but for some reason it is not working. The only error it is giving me is "Object doesn't support this property or method", and I am at a complete loss as of why. Here is my code. I would love insight or direction on how to fix my error.
Code:
Option Explicit

Sub SplitColumn()
Dim oRange As Range, sSeparator As String, iCountSep As Integer
Dim sTest As String, i As Integer, n As Long
Dim sLong As String, sShort As String, sRest As String




Set oRange = Application.InputBox("Select entire column", , Selection.Adddress, , , , , 8)
If oRange.Cells.Count = 1 Then MsgBox "You must select the entire column": Exit Sub
sSeparator = InputBox("What is the separator?", , ",")
sTest = oRange.Cells(2, 1) [COLOR=#008000]'test the first entry,excluding the label or header[/COLOR]
For i = 1 To Len(sTest)[COLOR=#008000] 'An error occurred while executing the command: INVALID-IB-CLASS details: In Basket Classification AH SM Coumadin did not match an active category value.[/COLOR]
    If Mid(sTest, i, 1) = sSeparator Then iCountSep = iCountSep + 1
Next i
For i = 1 To iCountSep [COLOR=#008000]'2 commas[/COLOR]
    oRange.Offset(0, i).EntireColumn.Insert
Next i
For n = 2 To oRange.CurrentRegion.Cells.Count
    With oRange.Cells(n, 1)
        sRest = oRange.Cells(n, 1)
       [COLOR=#008000] 'An error occurred while executing the command: INVALID-IB-CLASS details: In Basket Classification AH SM Coumadin did not match an active category value.[/COLOR]
For i = iCountSep To 1 Step -1 'from last column to first column
    sShort = Trim(Right(sRest, Len(sRest) - InStrRev(Trim(sRest), sSeparator)))
    If Right(sShort, 1) = sSeparator Then sShort = Left(sShort, Len(sShort) - 1)
    If Left(sShort, 1) = "0" Then oRange.Offset(0, 1).EntireColumn.Cells.NumberFormat = "@"
    [COLOR=#008000]' detects leading zeros[/COLOR]
    oRange.Offset(0, 1) = Trim(sShort)
    sRest = Trim(Left(sRest, Len(sRest) - Len(sShort)))
    If Right(sRest, 1) = sSeparator Then sRest = Left(sRest, Len(sRest) - 1)
    
Next i
If Left(sRest, 1) = "0" Then oRange.Offset(0, i).EntireColumn.Cells.NumberFormat = "@"


oRange.Offset(0, i) = CStr(sRest)


End With
Next n
oRange.CurrentRegion.EntireColumn.AutoFit
oRange.Cells(1, 1).Select
End Sub

Thank you.
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
I think you are getting that because address doesn't have 3 d's in it.
 
Upvote 0
I haven't looked deeply but this line will produce a big long column of sShort. That wont be your intention im sure.

Code:
oRange.Offset(0, 1) = Trim(sShort)
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top