Macro for text segregation

[Cris_93]

Hello excel masters :D

I need your help in solving what I believe is a easy fix. I'm working in developing a macro that will copy the information from an exported file and organize it by columns.

The exported info comes as below:

Well this info needs to be readjusted into the following format (7 columns).

RT Code	Description	Customer	Market	FactType	Unit	24/05/2020
RTE015	EDEN BEEF 6oZ MEGA BURGER 680G 336594011	OCADO	DEFAULT	[Live] Ocado Rolling forecast	P	322​
RTE006	EDEN BEEF ROAST RUMP JOINT	OCADO	DEFAULT	[Live] Ocado Rolling forecast	P	170.16​
RTE001	EDEN LAMB RACK 278703011	OCADO	DEFAULT	[Live] Ocado Rolling forecast	P	772.84​

Can you please help me with this?

This is the code I have being working on but it is not working:

Code[
Sub RollingForecastOcado()

Dim repFl As String
Dim rpSh As String
Dim btRw As Long



Application.ScreenUpdating = False
repFl = ActiveWorkbook.Name
rpSh = ActiveSheet.Name
Sheets("Rolling Forecast Ocado").Select
Cells.Select
Selection.ClearContents


Workbooks.Open Filename:= _
"\\IEDRGSFS01\data\Procurement\Quintiq DP Exports\RollingforecastExport.csv"
btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
Range("A1:P" & btRw).Select
Range("A1:P" & btRw).Select
Selection.Copy
Windows(repFl).Activate
Sheets("Rolling Forecast Ocado").Select
Range("A1:P" & btRw).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
Windows("RollingforecastExport.csv").Activate
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = False


Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "RT Code"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[1],6)"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A1638")
Range("A2:A1638").Select
Range("A1638").Select
Selection.AutoFill Destination:=Range("A1638:A1644"), Type:=xlFillDefault
Range("A1638:A1644").Select
Range("A1638").Select
Selection.AutoFill Destination:=Range("A1638:A3383"), Type:=xlFillDefault
Range("A1638:A3383").Select
ActiveWindow.ScrollRow = 3199
ActiveWindow.ScrollRow = 3058
ActiveWindow.ScrollRow = 1
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$H$3383").AutoFilter Field:=5, Criteria1:=Array( _
"TESCO", "TESCO NI", "="), Operator:=xlFilterValues
Rows("2:3379").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$H$112").AutoFilter Field:=5
Range("E6").Select
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("F:G").Select
Selection.Delete Shift:=xlToLeft
Columns("F:G").EntireColumn.AutoFit
Columns("E:E").ColumnWidth = 10.64
Columns("D:D").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
End Sub]

 

[denzo36]

Hi there,

You're data appears to be nicely set up to split by delimiter instead of VBA doing this.

You could use Power Query to very easily do this. What version of Excel do you have?

 

[Cris_93]

Hi Denzo36,

I have Excel 2016. Can you shortly explain how to do it? I would be very grateful!!

 

[Peter_SSs]

Could we have the exported info in a copyable form too? Preferably with XL2BB but failing that, like you posted the expected result above?

have Excel 2016.

I suggest that you update your Account details (click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[denzo36]

Sure, could you copy and paste your screen shot into your reply here so that I can copy and paste to excel?

 

[Cris_93]

Sure, please see below:

Product;Customer;Market;FactType;Unit;24/05/2020

RTE015 (EDEN BEEF 6oZ MEGA BURGER 680G 336594011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;0.00

RTE006 (EDEN BEEF ROAST RUMP JOINT);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;170.16

RTE001 (EDEN LAMB RACK 278703011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;772.84

RTE026 (EDEN LAMB SHOULDER DICED 400G);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;0.00

RTE013 (EDEN BEEF 6oZ MEGA BURGER 680G 336594011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;0.00

RTO021 (OCADO EXTRA LEAN BEEF STEAK MINCE 500G 77760011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;164506.40

RTO023 (Ocado GOLD Beef Burgers 454g 250399011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;0.02

RTO006 (KETTYLE GUINESS BURGERS 300G 394286011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;0.00

RTO022 (Ocado Gold Angus Beef Mince 500g 250403011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;13902.69

RTO002 (OCADO BEEF RUMP STEAK 255g 78372011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;429.61

RTO004 (OCADO 2 BEEF SIRLOIN STK wt GARLIC BTR 369988011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;35.46

RTO026 (OCADO ROLLED BRISKET JOINT 80146011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;222.41

RTO020 (Ocado Burgers & Sausage Pack 908g 236823011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;0.00

RTO042 (OCADO 4 QUARTER POUNDER BURGERS 72581011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;0.00

RTO044 (OCADO GOLD ITALIAN BEEF MEATBALLS 336G 82279011);OCADO;DEFAULT;[Live] Ocado Rolling forecast;P;0.02

This is exactly how it comes from the exported file. Thank you guys!

 

[denzo36]

Ok this is what I would do, Peter might have a different solution

1. I would delete row 1 where you're headers are (can be entered later).
2. Convert your data to a table - click anywhere in your data and press Ctrl+T. Leave the 'my table has headers' box unchecked.
3. Go to 'Data' ribbon -> select 'From Table/Range' which will take you to Power Query Editor.
4. Go to 'Home' tab -> Split Column -> By Delimiter
5. Pick your delimiter as 'Space' from the drop down options and select 'split at' - left-most delimiter and click ok.
6. This will split out 'RT Code' portion.
7. Now select column 2 and split by delimiter again and chosen 'semi-column' delimiter and select 'each occurence of delimiter'. This will split out the remaining bits.
8. Double click on each of the column headers and rename them to what you want.
9. Once done, click 'close and load' on top left hand side - close and load to and select where in your spreadsheet you want it.

Done!

 

[Peter_SSs]

See how this goes with a copy of your data.

Sub SplitIt()
  With Columns("A")
    .Cells(1).Value = "RT Code;Description;" & Split(.Cells(1).Value, ";", 2)(1)
    .Replace What:=" (", Replacement:=";", LookAt:=xlPart
    .Replace What:=");", Replacement:=";", LookAt:=xlPart
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
    .Resize(, 7).AutoFit
  End With
End Sub

 

[Cris_93]

Hi Peter,

Thank you so much for your reply! The macro is working perfectly! I just have one small issue. The file from where I copy the info remains open after the information is pasted on the main file. I tried to work a vba code to have it close but for some reason it gives me an error.

The code below is working perfecly but the only issue is that the file "RollingforecastExport.csv" continues open and I would like to have it close.

Sub SplitIt()

Columns("A:I").Select
Selection.ClearContents

Workbooks.Open Filename:= _
        "X:\Procurement\Quintiq DP exports\RollingforecastExport.csv"
        Columns("A:A").Select
        Selection.Copy
        Windows("Ocado Rolling Forecast.xlsm").Activate
        Columns("A:A").Select
        ActiveSheet.Paste

With Columns("A")
    .Cells(1).Value = "RT Code;Description;" & Split(.Cells(1).Value, ";", 2)(1)
    .Replace What:=" (", Replacement:=";", LookAt:=xlPart
    .Replace What:=");", Replacement:=";", LookAt:=xlPart
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
    .Resize(, 7).AutoFit
  End With
  
End Sub

Once again thank you!!

Regards,
Cristian

 

[Peter_SSs]

The macro is working perfectly!

Good news!

I just have one small issue.

.. the file "RollingforecastExport.csv" continues open and I would like to have it close.

Untested as I do not have you files or folder structure but try this. I have highlighted the added or changed lines.

Sub SplitIt_v2()
  Dim wbCSV As Workbook
  
  Columns("A:I").Select
  Selection.ClearContents
  
  Set wbCSV = Workbooks.Open(Filename:="X:\Procurement\Quintiq DP exports\RollingforecastExport.csv")
          Columns("A:A").Select
          Selection.Copy
          Windows("Ocado Rolling Forecast.xlsm").Activate
          Columns("A:A").Select
          ActiveSheet.Paste
  
  With Columns("A")
      .Cells(1).Value = "RT Code;Description;" & Split(.Cells(1).Value, ";", 2)(1)
      .Replace What:=" (", Replacement:=";", LookAt:=xlPart
      .Replace What:=");", Replacement:=";", LookAt:=xlPart
      .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
      .Resize(, 7).AutoFit
  End With
  
  wbCSV.Close SaveChanges:=False
  
End Sub