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
Peter_SSs said:
:oops: Try this one.

VBA Code: 
Sub GetData_v2()
  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 = "^([^ ]+)( )([^ ]+)( )([^ ]+ )([^ ]+)( )(.+)( )([^ ]+)( )([^ ]+)$"
  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 s Like "#*.* #*.* EA * #*.* #*.*#"
            k = k + 1
            a(k, 1) = RX.Replace(s, "$1;$3;$6;$8;$10;$12")
            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...
1623182405605.png


Everything is working great just under itemID, sometimes the pattern has a space between for example MFP CAF2174C so its splitting it with the description. Anyway around that by any chance?
 
Upvote 0

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
​
What is your logic to separate the ID and the description ?​
 
Upvote 0
BalloutMoe said:
sometimes the pattern has a space between for example MFP CAF2174C
Click to expand...
Do you mean sometimes the pattern does not have a space between ..?
If so, how do we decide where a split should occur?
 
Upvote 0
​
Ok, according to the attachment from the source text file the logic is obvious so very not an issue to separate any column …​
​
But comparing this source text file and your result workbook : whow ! What is the logic, why so few rows ?​
So I very need to understand what are the criterias from the source text file to obtain the same workbook result …​
 
Upvote 0
Peter_SSs said:
Do you mean sometimes the pattern does not have a space between ..?
If so, how do we decide where a split should occur?
Click to expand...
It has an extra space after the id
1623194723747.png

MFPTC2055 is an item ID number so is MFPCAF2174C but sometimes there is a space between MPC and CAF2174C so it does not take the number. I would like to have item ID to be anything before the word MIGHTY or DRAIN.
 
Upvote 0
Marc L said:
​
Have you read at least post #24 ?​
Click to expand...
Sorry you posted that right as I was posting my comment. I’ll be back by the laptop in 15 minutes. I will post exactly what is happening. Thank you
 
Upvote 0
BalloutMoe said:
I would like to have item ID to be anything before the word MIGHTY or DRAIN.
Click to expand...
OK, try this

VBA Code: 
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
 
Upvote 0
Solution
Peter_SSs said:
OK, try this

VBA Code: 
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
Click to expand...
Thank you again, I tried this code it works better then the one before but it is still skipping over some for some reason.
1​
1​
MFPA90100MIGHTYAIR FILTER EA$ 9.95$ 9.95
2​
2​
MFPA90097MIGHTYAIR FILTER EA$ 6.99$ 13.98
1​
1​
MFPA90096MIGHTYAIR FILTER EA$ 9.95$ 9.95
1​
1​
MFPA6911MIGHTYAIR FILTER EA$ 9.95$ 9.95
1​
1​
MFPA3590MIGHTYAIR FILTER EA$ 7.99$ 7.99
1​
1​
MFPA4048MIGHTYAIR FILTER EA$ 6.99$ 6.99
2​
2​
MFPCAF2152 MIGHTY CABINAIR FILTER$ 9.95$ 19.90
2​
2​
MFPCAF2161 MIGHTY CABINAIR FITLER$ 9.95$ 19.90
1​
1​
MFPCAF2145C MIGHTY CABINAIR FILTER$ 10.99$ 10.99
2​
2​
MFPCAF2139 MIGHTY CABINAIR FILTER$ 9.95$ 19.90
1​
1​
MFPCAF2135 MIGHTY CABINAIR FILTER$ 13.95$ 13.95
1​
1​
MFPTC2131MIGHTY TEC SELECT CABIN AIR FILTER$ 6.50$ 6.50
2​
2​
MFPTC2130MIGHTY TECSELECT CABIN AIR FILTER$ 8.85$ 17.70
2​
2​
MFPTC2127MIGHTY TEC SELECT CABIN AIR FILTER$ 7.75$ 15.50
1​
1​
MFPTC2122MIGHTY TECSELECT CABIN AIR FILTER$ 5.99$ 5.99
1​
1​
MFPCAF2104 MIGHTY CABINAIR FILTER$ 10.95$ 10.95
4​
4​
MFPCAF2084 MIGHTY CABINAIR FILTER$ 9.95$ 39.80
1​
1​
MFPCAF2086 MIGHTY CABINAIR FILTER$ 12.95$ 12.95
2​
2​
MFPTC2090MIGHTY TECSELECT CABIN AIR FILTER$ 5.99$ 11.98
1​
1​
MFPCAF2097 MIGHTY CABINAIR FILTER$ 8.25$ 8.25
1​
1​
MFPTC1766MIGHTY TECSELECT CABIN AIR FILTER$ 4.99$ 4.99

As you can see still some part numbers are still being put in the description. MFP should also include the part number. Which is MFPCAF2152, MFPCAF2161. It is much better the V2
 
Upvote 0
Peter_SSs said:
OK, try this

VBA Code: 
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
Click to expand...
I tried RX.Pattern = "^([^ ]+)( )([^ ]+)( )(EA )(.+?)( )(MIGHTY( )|DRAIN)(.+)( )([^ ]+)( )([^ ]+)$" adding a space after the "MIGHTY" it works and takes all the Item ID but the description now is only MIGHTY OR DRAIN
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,224,828
Messages
6,181,215
Members
453,024
Latest member
Wingit77

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