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

B

BalloutMoe

Board Regular
Joined
Jun 4, 2021
Messages
137
Office Version
  1. 365
Platform
  1. Windows
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.
 
Sort by date Sort by votes
BalloutMoe said:
I get a runtime error 1004 "Application-defined or object-defined error"
Click to expand...
As it works on my side so you obviously did not follow the dark red direction for the location where must be the procedure …​
 
Upvote 0

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Marc L said:
As it works on my side so you obviously did not follow the dark red direction for the location where must be the procedure …​
Click to expand...
I put it in a module now and it give me an error here With [A2].Resize(R)
 
Upvote 0
BalloutMoe said:
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?
Click to expand...
Great to see you are trying to figure out some of the pattern yourself, but I don't think the first pattern in my quote here quite works. Running that with the sample text file you provided produces some extra (incorrect) lines at the start of some invoices, including the first one.
The main culprit there is an unwanted extra "|" that you included as highlighted. The "|" character is equivalent to an "OR" statement so your code basically says EA or CS or GL or nothing, which introduces a lot of extraneous possibilities.
Your attempt at including the possibility of a K before MIGHTY was understandable, but unfortunately not correct, see below.
I would also remove the repeated space in the EA/CS/GL section and put it once separately afterwards. This also changes the RX.Replace line later in the code as an extra term has been introduced to the pattern. Give this a try, noting that K? in the pattern means "zero or 1 K"

VBA Code: 
Sub GetData_v4()
  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 = "^(\d+\.\d+)( )(\d+\.\d+)( )(EA|CS|GL)( )(.+?)( )(K?MIGHTY|DRAIN)(.+)( )(\d+\.\d+)( )(\d+\.\d+)$"
  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;$7;$9$10;$12;$14")
            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
 
Upvote 0
Peter_SSs said:
Great to see you are trying to figure out some of the pattern yourself, but I don't think the first pattern in my quote here quite works. Running that with the sample text file you provided produces some extra (incorrect) lines at the start of some invoices, including the first one.
The main culprit there is an unwanted extra "|" that you included as highlighted. The "|" character is equivalent to an "OR" statement so your code basically says EA or CS or GL or nothing, which introduces a lot of extraneous possibilities.
Your attempt at including the possibility of a K before MIGHTY was understandable, but unfortunately not correct, see below.
I would also remove the repeated space in the EA/CS/GL section and put it once separately afterwards. This also changes the RX.Replace line later in the code as an extra term has been introduced to the pattern. Give this a try, noting that K? in the pattern means "zero or 1 K"

VBA Code: 
Sub GetData_v4()
  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 = "^(\d+\.\d+)( )(\d+\.\d+)( )(EA|CS|GL)( )(.+?)( )(K?MIGHTY|DRAIN)(.+)( )(\d+\.\d+)( )(\d+\.\d+)$"
  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;$7;$9$10;$12;$14")
            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
Click to expand...
I had implemented it with the V2 and added some case like statements. I will try your above code tomorrow morning. Thank you for your continuous help. I spent the day trying to understand what each line did and googling to get some answers and just trial and error. Until I came up with desired info.
 
Upvote 0
BalloutMoe said:
I put it in a module now and it give me an error here With [A2].Resize(R)
Click to expand...
As yet stated it can not work on « a module » but only on the worksheet module according to your last attachment …​
 
Upvote 0
Peter_SSs said:
Great to see you are trying to figure out some of the pattern yourself, but I don't think the first pattern in my quote here quite works. Running that with the sample text file you provided produces some extra (incorrect) lines at the start of some invoices, including the first one.
The main culprit there is an unwanted extra "|" that you included as highlighted. The "|" character is equivalent to an "OR" statement so your code basically says EA or CS or GL or nothing, which introduces a lot of extraneous possibilities.
Your attempt at including the possibility of a K before MIGHTY was understandable, but unfortunately not correct, see below.
I would also remove the repeated space in the EA/CS/GL section and put it once separately afterwards. This also changes the RX.Replace line later in the code as an extra term has been introduced to the pattern. Give this a try, noting that K? in the pattern means "zero or 1 K"

VBA Code: 
Sub GetData_v4()
  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 = "^(\d+\.\d+)( )(\d+\.\d+)( )(EA|CS|GL)( )(.+?)( )(K?MIGHTY|DRAIN)(.+)( )(\d+\.\d+)( )(\d+\.\d+)$"
  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;$7;$9$10;$12;$14")
            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
Click to expand...
This is the code that is currently working for me with other invoices as they had a bit more information on them. Everything is being extracted correctly except this line is being skipped.
"2.000 2.000 CS MBL 122260 (K)MOBIL 1 TURBO DIESEL 5W40 3GL 73.6900 147.38" This is how it appears in the text file. I tried K?MOBIL but it did not do anything either. I need two MOBIL criteria's one that shows up just MOBIL and the other is the (K)MOBIL.

VBA Code: 
Sub GetDataMightyLubricants()
  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
  Range("A:I").Cells.Interior.ColorIndex = xlNone
  Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = "^([^ ]+)( )([^ ]+)( )(EA |CS |GL )(.+?)( )(MIGHTY|GOLDEN|MOTORCRAFT|MOBIL|VALVOLINE|COMPLETE|SHELL|BRAKE|CHEVRON|ROYAL|CASTROL|ANMEX|PENNZOIL|WINDSHIELD|UNIVERSAL)(.+)( )([^ ]+)( )([^ ]+)$"
  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
  
    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
 Call MightyDATACleanUp.CleanUpMightyData
 Call MightyDATACleanUp.brakecleaner
 Call MightyDATACleanUp.Highlight_Greater_Than
End Sub
 
Upvote 0
​
As no issue on my side with your last attachment so try with the same attachment …​
​
By the way what is the name of the module ?​
 
Upvote 0
Sheet
Marc L said:
​
As no issue on my side with your last attachment so try with the same attachment …​
​
By the way what is the name of the module ?​
Click to expand...
Sheet1(INVOICEDATA) tried it here with error on the same file
Module1 tried it here with error on the same file
 
Upvote 0
BalloutMoe said:
This is the code that is currently working for me with other invoices as they had a bit more information on them. Everything is being extracted correctly except this line is being skipped.
"2.000 2.000 CS MBL 122260 (K)MOBIL 1 TURBO DIESEL 5W40 3GL 73.6900 147.38" This is how it appears in the text file. I tried K?MOBIL but it did not do anything either. I need two MOBIL criteria's one that shows up just MOBIL and the other is the (K)MOBIL.
Click to expand...
I misunderstood previously that the parentheses around the K were literal and not part of the RX pattern syntax.

So, you are now saying we could have MIGHTY or DRAIN or MOBIL?
Is that the full list?

Are you also saying that any of those could be prefixed by (K)?

Any other possible prefixes? eg K by itself or something else in parentheses?
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top