I am struggling to create a VB script to take the data in column A, run text to columns with a fixed width, and then remove duplicates

I have a CSV file that has data in column A, but I only need part of it and need to remove the duplicates.

Here is the data I am pasting in column A on my "CSV" worksheet:

RAW Data in column A:

I need a VB script that can take that data, and separate the text in columns, and remove the duplicates. So the output looks like this:

Desired Output:

I only care about keeping the three digit number in column A and removing those duplicates. All other data can be discarded.

I plan on running the script by adding a button to the worksheet.

Any help is greatly appreciated!

I tried using the automation macro within excel, and it works well enough, but I need to be able to add the functionality for all users for all copies of the workbook.

Here is the code from the automation macro:

function main(workbook: ExcelScript.Workbook) {
    let selectedSheet = workbook.getActiveWorksheet();
    // Text to columns on range A1:A300 on selectedSheet
    for (let row = 0; row < selectedSheet.getRange("A1:A300").getRowCount(); row++) {
        let sourceRange: ExcelScript.Range;
        let destinationRange: ExcelScript.Range;
        let sourceRangeValues: string;
        let destinationValues: string[];
        let previousValue: number;
        sourceRange = selectedSheet.getRange("A1:A300");
        destinationRange = selectedSheet.getRange("A1");
        sourceRangeValues = sourceRange.getRow(row).getValues()[0][0].toString()
        destinationValues = [];
        previousValue = 0;
        for (let i = 0; i < 1; i++) {
          const cur = [3][i];
          destinationValues.push(sourceRangeValues.substring(previousValue, cur))
          previousValue = cur;
        }
        destinationValues.push(sourceRangeValues.substring(previousValue));
        destinationRange.getOffsetRange(row, 0).getResizedRange(0, destinationValues.length - 1).setValues([destinationValues]);
    }
    // Remove duplicates from range A1:A114 on selectedSheet
    selectedSheet.getRange("A1:A300").removeDuplicates([0], false);
}

Pasting that in to VB didn’t work.
My internet sleuthing resulted in a failure as well.

Sub txt2col_remdup()

    Range("A1:A300").TextToColumns
    Range("A1:A300").RemoveDuplicates
    
End Sub

>Solution :

Please try.

Sub Macro2()
    Dim r As Range
    Set r = Range("A1").CurrentRegion
    r.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(3, 9)), TrailingMinusNumbers:=True
    r.RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

Microsoft documentation:

XlColumnDataType enumeration (Excel)

Dictionary object is another option to get it done.

Sub Demo()
    Dim objDic As Object, rngData As Range
    Dim i As Long, sKey As String
    Dim arrData
    Set objDic = CreateObject("scripting.dictionary")
    Set rngData = Range("A1").CurrentRegion
    arrData = rngData.Value
    For i = LBound(arrData) To UBound(arrData)
        sKey = "'" & Left(arrData(i, 1), 3)
        objDic(sKey) = ""
    Next i
    rngData.Clear
    Range("A1").Resize(objDic.Count, 1) = Application.Transpose(objDic.keys)
    Set objDic = Nothing
End Sub