VBA Text To Column

[Sharid]

I have a list of urls in column B I need to remove everything after AND INCLUDING the ? and then delete any duplicates In column B.

Q) How can I do this with Vba Text to Column?

The list in Column B will be dynamic. All the urls will have a question mark in them however they will all be of different lengths.

Currently I have to use text to Column, I want to do this quickly with VBA
Currently everything after the ? goes into Column C, column C is then cleared I have to then delete duplicates in column B, leaving only unique records

 

[Fluff]

With text to columns on page 3 of the wizard you can select the 2nd column in the data preview box & then check the "Do not import" option. That way you won't get the 2nd column.
If you use the recorder you can get the code for it along with the remove duplicate code using the "remove duplicates" option on the data tab.

 

[Sharid]

I have just recorded this Macro, and made a more readable version below. Not too sure if the delete duplicates could be written better

Sub TextToColumn()
'
' TextToColumn Macro

    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="?", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    ActiveSheet.Range("$A$1:$E$110585").RemoveDuplicates Columns:=2, Header:= _
        xlNo
    Columns("C:C").Select
    Selection.ClearContents
    Range("C2").Select
    ActiveWorkbook.Save
    ActiveWindow.SmallScroll Down:=-6
End Sub

Readable version

Sub TextToColumn()
'
' TextToColumn Macro
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=True, _
      Semicolon:=False, _
      Comma:=False, _
      Space:=False, _
      Other:=True, _
      OtherChar:="?"
   
'delete Duplicates
  ActiveSheet.Range("$A$1:$E$110585").RemoveDuplicates Columns:=2, Header:=xlNo
    Columns("C:C").Select
    Selection.ClearContents
    Range("C2").Select
    ActiveWorkbook.Save
    ActiveWindow.SmallScroll Down:=-6
   
End Sub

The Active Sheet will change, the results will show in a listbox, as I will be running it from a userform and the sheet may not always be active. The Column Will always be B. I assume this will be an issue.

 

[Fluff]

If you include this in the text to columns

FieldInfo:=Array(Array(1, 1), Array(2, 9))

there is no need to clear col C

 

[Sharid]

This is the fine one, seems to work, Im not too sure on the delete duplicate it has an Range and that will be dynamic

  Columns("B:B").Select
    Selection.TextToColumns _
      Destination:=Range("B1"), _
      DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=True, _
      Semicolon:=False, _
      Comma:=False, _
      Space:=False, _
      Other:=True, _
      OtherChar:="?", _
      FieldInfo:=Array(Array(1, 1), Array(2, 9))
 'delete Duplicates
  ActiveSheet.Range("$A$1:$E$110585").RemoveDuplicates Columns:=2, Header:=xlNo

 

[Fluff]

How about

Range("$A$1").CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlNo

 

[Sharid]

Super, I think that will do it, As always super support Fluff

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Sharid]

I thought this was sorted, however the text to column only works if I am ON the sheet, I need to run this from a userform and dat to show in a list box, I can be on any sheet. However the text to column needs to work on Sheet4 "Data". I tried to set the sheet and also with a WITH but can not get it to work

 Set wb = ThisWorkbook
    Set wsSheet = wb.Sheets("Data")
   ' With Sheets("Data")
        Columns("B:B").Select
            Selection.TextToColumns _
            Destination:=Range("B1"), _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=True, _
            Semicolon:=False, _
            Comma:=False, _
            Space:=False, _
            Other:=True, _
            OtherChar:="?", _
            FieldInfo:=Array(Array(1, 1), Array(2, 9))
            
      ' End With

 

[Fluff]

Try it like

 Set WB = ThisWorkbook
    WB.Sheets ("Data")
   
        .Columns("B:B").TextToColumns _
            Destination:=Range("B1"), _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=True, _
            Semicolon:=False, _
            Comma:=False, _
            Space:=False, _
            Other:=True, _
            OtherChar:="?", _
            FieldInfo:=Array(Array(1, 1), Array(2, 9))
            
       End With