将B列的拆分数据粘贴到D＆E列中

Question

In column B there is the 5 character item code + the item description. I managed to make a macro that copy/pastes the 5 character item codes from column B into column D and the item descriptions into column E.

Example:

          Column B              Column C  Column D     Column E
XX787 DO BOLOGNESE 2X2.28KG FR   <other>    XX787    DO BOLOGNESE 2X2.28KG FR

I am facing the following issues:

• About 1% of the item codes are not 5 characters but 8 characters, for example
• This percentage that exists out of 8 characters exists of numbers and starts with 0

As you can see, the last 2 are examples of item codes that have a different format, and even though there is only a small amount of them, they have to be taken into account of course.

So with my current coding, the following issues arise:

I think the macro should do the following to make this work properly:

For item codes in column D: Copy/paste all the characters BEFORE the first space from column B For item descriptions in column E: Copy/paste all the characters AFTER the first space

The code I am currently running for this is the following:

Sub Seperate_Item_Code_And_Description_Code()
    'Copy/paste the item codes and descriptions from column B to column D and E seperately

    Range("B12").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("D12"), DataType:=xlFixedWidth, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:= _
    True
End Sub

Answer 1

Try this coded and conditional text-to-columns.

Option Explicit

Sub wqewtrqw()
    Dim s As Long, a As Long, aVALs As Variant

    With Worksheets("Sheet5")
        aVALs = .Range(.Cells(12, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
        ReDim Preserve aVALs(LBound(aVALs, 1) To UBound(aVALs, 1), 1 To 2)
        For a = LBound(aVALs, 1) To UBound(aVALs, 1)
            s = InStr(1, aVALs(a, 1), Chr(32))
            aVALs(a, 2) = Mid(aVALs(a, 1), s + 1)
            aVALs(a, 1) = Left(aVALs(a, 1), s - 1)
        Next a
        .Cells(12, "D").Resize(UBound(aVALs, 1), UBound(aVALs, 2)) = aVALs
    End With
End Sub