Excel VBA Parse Column A into multiple columns help but with conditions

[BalloutMoe]

Hello, I have a TXT file that gets imported in excel and it always ends up in column A. I am trying to split the data up however. The middle columns with text usually vary. For example

1.000 1.000 EA MWPTS16 MIGHTY 16in TecSelect WIPER BLADE EA 1.9900 1.99

1.000 1.000 EA MWPTS18 MIGHTY 18in TecSelect WIPER BLADE EA 1.9900 1.99

1.000 1.000 EA MWPTS21 MIGHTY 21in TecSelect WIPER BLADE EA 1.9900 1.99

1.000 1.000 EA MLE 9012LL MIGHTY HIR2/12V LONG LIFE HALOGEN 16.9800 16.98

EA

1.000 1.000 EA MLE H11-55W MIGHTY HALOGEN HEADLAMP EA 7.9500 7.95

4.000 4.000 EA MSL 80-39 MIGHTY DRAIN PLUG EA 4.9500 19.80

1.000 1.000 EA MFPTC2064 MIGHTY TECSELECT CABIN AIR FILTER 5.4900 5.49

EA

I would like to split like this: 1.000 | 1.000 EA | rest of the text here | Then 1.9900 | 1.99. Ending up with 5 columns. However the length of the text varies every time. So if I split them normally some number won't be inline with each other. Can this be done in any specific way. Or any way to guide me get started.

 

[BalloutMoe]

Never mind it works now. After running it a few times now it works. THANK YOU is their a way I can contribute something for your help. AMAZING WORK

 

[Peter_SSs]

Never mind it works now.

Glad it is resolved.

is their a way I can contribute something for your help.

No, this is a free forum. See #5 of the Forum Rules

 

[BalloutMoe]

Glad it is resolved.


No, this is a free forum. See #5 of the Forum Rules

I know it is but I am just forever thankful to you and your help. I will be studying your code to help me do another invoice format I receive. Thank you, god bless

 

[Peter_SSs]

No problem. People help here just because they want to.

 

[Marc L]

According to your last attachment a VBA basics demonstration to paste to the Sheet1 worksheet module :​

Sub Demo1()
  Const E = " EA  ", S = "  "
    Dim V, F%, R&, L&
        V = Application.GetOpenFilename("Text files,*.txt"):  If V = False Then Exit Sub
        UsedRange.Offset(1).Clear
        F = FreeFile
        Open V For Input As #F
        V = Filter(Split(Input(LOF(F), #F), vbCrLf), E, True)
        Close #F
    For R = 0 To UBound(V)
        F = 0
        L = -1
        While F < 3:  F = F + 1:  L = InStrRev(V(R), S, L):  Wend
        V(R) = Replace(Replace(Left(V(R), L - 1), E, vbTab, , 1), S, vbTab, , 2) & Replace(V(R), S, vbTab, L, 3)
    Next
        Application.ScreenUpdating = False
    With [A2].Resize(R)
        .Value2 = Application.Transpose(V)
        .TextToColumns , 1, , , True, , , , , , , "."
        .Columns("C:D").AutoFit
    End With
        Application.ScreenUpdating = True
End Sub

 

[BalloutMoe]

According to your last attachment a VBA basics demonstration to paste to the Sheet1 worksheet module :​

Sub Demo1()
  Const E = " EA  ", S = "  "
    Dim V, F%, R&, L&
        V = Application.GetOpenFilename("Text files,*.txt"):  If V = False Then Exit Sub
        UsedRange.Offset(1).Clear
        F = FreeFile
        Open V For Input As #F
        V = Filter(Split(Input(LOF(F), #F), vbCrLf), E, True)
        Close #F
    For R = 0 To UBound(V)
        F = 0
        L = -1
        While F < 3:  F = F + 1:  L = InStrRev(V(R), S, L):  Wend
        V(R) = Replace(Replace(Left(V(R), L - 1), E, vbTab, , 1), S, vbTab, , 2) & Replace(V(R), S, vbTab, L, 3)
    Next
        Application.ScreenUpdating = False
    With [A2].Resize(R)
        .Value2 = Application.Transpose(V)
        .TextToColumns , 1, , , True, , , , , , , "."
        .Columns("C:D").AutoFit
    End With
        Application.ScreenUpdating = True
End Sub

Thank you I will give this a go as well

 

[BalloutMoe]

According to your last attachment a VBA basics demonstration to paste to the Sheet1 worksheet module :​

Sub Demo1()
  Const E = " EA  ", S = "  "
    Dim V, F%, R&, L&
        V = Application.GetOpenFilename("Text files,*.txt"):  If V = False Then Exit Sub
        UsedRange.Offset(1).Clear
        F = FreeFile
        Open V For Input As #F
        V = Filter(Split(Input(LOF(F), #F), vbCrLf), E, True)
        Close #F
    For R = 0 To UBound(V)
        F = 0
        L = -1
        While F < 3:  F = F + 1:  L = InStrRev(V(R), S, L):  Wend
        V(R) = Replace(Replace(Left(V(R), L - 1), E, vbTab, , 1), S, vbTab, , 2) & Replace(V(R), S, vbTab, L, 3)
    Next
        Application.ScreenUpdating = False
    With [A2].Resize(R)
        .Value2 = Application.Transpose(V)
        .TextToColumns , 1, , , True, , , , , , , "."
        .Columns("C:D").AutoFit
    End With
        Application.ScreenUpdating = True
End Sub

I get a runtime error 1004 "Application-defined or object-defined error"

 

[BalloutMoe]

OK, try this

Sub GetData_v3()
  Dim RX As Object
  Dim a As Variant
  Dim sFile As String, s As String, InvNo As String
  Dim k As Long
  Dim bInv As Boolean
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = "^([^ ]+)( )([^ ]+)( )(EA )(.+?)( )(MIGHTY|DRAIN)(.+)( )([^ ]+)( )([^ ]+)$"
  sFile = Application.GetOpenFilename()
  If sFile <> "False" Then
    Open sFile For Input As #1
    ReDim a(1 To Rows.Count, 1 To 1)
    Do Until EOF(1)
        Line Input #1, s
        s = Application.Trim(s)
        Select Case True
          Case s = "INVOICE"
            bInv = True
          Case bInv And IsNumeric(Left(s, 1)) And s <> InvNo
            k = k + 1
            a(k, 1) = "Inv: " & s
            InvNo = s
            bInv = False
          Case RX.Test(s)
            k = k + 1
            a(k, 1) = RX.Replace(s, "$1;$3;$6;$8$9;$11;$13")
            bInv = False
          Case Else
            bInv = False
        End Select
    Loop
    Close #1
    Sheets.Add
    With Range("A2").Resize(k)
      .Value = a
      .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
      .Resize(, 6).Rows(0).Value = Array("Ordered", "Shipped", "Item ID", "Item Description", "Unit Price", "Ext price")
      .Resize(, 6).EntireColumn.AutoFit
    End With
  End If
End Sub

Can I add multiple patterns to this line? In some cases I have another style invoice which is very similar but uses CS instead of each. Can I have them be on the same RX.pattern?
"^([^ ]+)( )([^ ]+)( )(EA )(.+?)( )(MIGHTY|DRAIN)(.+)( )([^ ]+)( )([^ ]+)$"
can I add this to the above code? If so how would I implement it. I tried a few things but with no results. Thank you
"^([^ ]+)( )([^ ]+)( )(CS)(.+?)( )(MIGHTY|DRAIN)(.+)( )([^ ]+)( )([^ ]+)$"

 

[BalloutMoe]

I tried or but it did not work
"^([^ ]+)( )([^ ]+)( )(EA )(.+?)( )(MIGHTY|DRAIN)(.+)( )([^ ]+)( )([^ ]+)$" or "^([^ ]+)( )([^ ]+)( )(CS)(.+?)( )(MIGHTY|DRAIN)(.+)( )([^ ]+)( )([^ ]+)$"

 

[BalloutMoe]

I figured it out but one more problem...never ends lol
"^([^ ]+)( )([^ ]+)( )(EA |CS |GL |)(.+?)( )(MIGHTY|DRAIN)(.+)( )([^ ]+)( )([^ ]+)$" this is what worked.
however one of the "MIGHTY" Conditions contains a (K) before it
"^([^ ]+)( )([^ ]+)( )(EA |CS |GL |)(.+?)( )(MIGHTY|DRAIN|(K)MIGHTY)(.+)( )([^ ]+)( )([^ ]+)$" but this is not working I am assuming because of the () around the K anyway around that?