macro to split data to their respective headers

[RAM72]

Hi All


I have a list of data extracted from an interface but need to be split to their respective headers
Tariif header| Description header| ori header |Total header.

However the data are uneven thefirst header is always numerical to 8 digits and the other headers are alphanumerical.

 

[jindon]

Try

Sub test()
    Dim a, x, i As Long, ii As Long
    With Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 5)
        .Offset(1, 1).ClearContents
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Pattern = "^(\d+) (.*?)( ([A-Z]{2}) *(Total)?)?$"
            For i = 2 To UBound(a, 1)
                If .test(a(i, 1)) Then
                    x = Split(.Replace(a(i, 1), "'$1^$2^$4^$5"), "^")
                    For ii = 0 To UBound(x)
                        a(i, ii + 2) = x(ii)
                    Next
                End If
            Next
        End With
        .Value = a
    End With
End Sub

 

[mohadin]

what a magic

 

[jindon]

what a magic

Glad you like it.

 

[RAM72]

Try

Sub test()
    Dim a, x, i As Long, ii As Long
    With Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 5)
        .Offset(1, 1).ClearContents
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Pattern = "^(\d+) (.*?)( ([A-Z]{2}) *(Total)?)?$"
            For i = 2 To UBound(a, 1)
                If .test(a(i, 1)) Then
                    x = Split(.Replace(a(i, 1), "'$1^$2^$4^$5"), "^")
                    For ii = 0 To UBound(x)
                        a(i, ii + 2) = x(ii)
                    Next
                End If
            Next
        End With
        .Value = a
    End With
End Sub

Am impressed by your coding techniques Jindon

Thank you a lot save me from a tedious task