Macro that takes data from 3 files and create a final file with restrictions

[Cris_93]

Hello Excel masters

I need your help in order to develop a final file (CustomerForecast) from 3 different files with some restrictions.

The final file should have the below format. The columns "FactType" and "Unit" should have always the same values.

Depot/StoreFormat	Product	FactType	Unit	Date	Value
Dublin	RTP088	Customer Forecast	Cases	02/11/2019	23
Belfast	RTB222	Customer Forecast	Cases	12/11/2019	32
Hatfield	RTP088	Customer Forecast	Cases	07/11/2019	30
Dordon	RTL008	Customer Forecast	Cases	05/11/2019	30
…	…	…	…	…	…

<tbody>
</tbody>

The other data for the others 4 columns come from the below 3 different files. I will put in red the required columns from each file:

"ROI.csv"

Supplier number

Category area

Star line

Tpnb

Description

Tpnd

Case size

Occ

Depot number

Depot name

Forecast date

Order date

Delivery date

Forecast cases

5997500

MFP

N

52440995

PORK MINCE 500G

31411873

8

5.05E+12

735

BALLYMUN FRESH PBL

03/10/2019

04/10/2019

05/10/2019

40

5997500

MFP

N

52445008

IRISH LAMB MINCE 15% FAT 533G

37216980

4

5.06E+12

735

BALLYMUN FRESH PBL

03/10/2019

04/10/2019

07/10/2019

10

5997500

MFP

N

52483552

T. ROUND STEAK BEEF MINCE 10% FAT 554G

34945576

12

5.06E+12

735

BALLYMUN FRESH PBL

03/10/2019

16/10/2019

17/10/2019

102

5997500

MFP

N

63755738

T. FIN* IRISH CANADIAN MAPLE RASHERS 240G

32607750

8

5.06E+12

735

BALLYMUN FRESH PBL

03/10/2019

21/10/2019

22/10/2019

48

…

…

…

…

…

…

…

…

…

…

…

…

…

…

<colgroup><col style="text-align: center;"><col style="text-align: center;"><col span="2" style="text-align: center;"><col style="text-align: center;"><col span="3" style="text-align: center;"><col style="text-align: center;"><col style="text-align: center;"><col style="text-align: center;"><col style="text-align: center;"><col style="text-align: center;"><col style="text-align: center;"></colgroup><tbody>
</tbody>

The Depot name "BALLYMUN FRESH PBL" should be picked as "Dublin" to the final file;

"NI.xls"

Supplier number	Occ	Tpnd	Description	Depot number	Depot name	Case size	Forecast date	Order date	Delivery date	Forecast cases
6242200	2.0955E+11	28798712	T.FIN 1 BEEF RIBEYE STEAK	835	NI BELFAST FRESH PBL	12	03/10/2019	19/10/2019	21/10/2019	2
6242200	2.0955E+11	28798712	T.FIN 1 BEEF RIBEYE STEAK	835	NI BELFAST FRESH PBL	12	03/10/2019	10/10/2019	11/10/2019	8
6242200	2.0955E+11	28798712	T.FIN 1 BEEF RIBEYE STEAK	835	NI BELFAST FRESH PBL	12	03/10/2019	05/10/2019	07/10/2019	21
6242200	2.0955E+11	28798712	T.FIN 1 BEEF RIBEYE STEAK	835	NI BELFAST FRESH PBL	12	03/10/2019	09/10/2019	10/10/2019	9
…	…	…	…	…	…	…	…	…	…	...

<tbody>
</tbody>

The Depot name "NI BELFAST FRESH PBL" should be picked as "Belfast" to the final file;

"Ocado.xls"

Forecast Delivery Date	Delivery Place	Order Group	SKU	Supplier Line Number	Product Description	Case Barcode	Forecast Order Qty (Cases)
06 October 2019 05:00:00	Dordon	Do: HFS	77760011	77760011	Ocado Lean Beef Steak Mince 5% Fat (500 GR)	15055004195	60
06 October 2019 05:00:00	Dordon	Do: HFS	296274011	296274011	Eden Beef Steak Mince 15% Fat (500 GR)	05391810242	38
06 October 2019 08:30:00	Hatfield	Ha: HFS	435984011	435984011	Eden Lean Beef Steak Mince 5% Fat (400 GR)	05391811102	51
07 October 2019 08:00:00	Erith CFC	Er: HFS	72581011	72581011	Ocado 4 Quarter Pounder Beef Burgers (454 GR)	15055002382	2
07 October 2019 08:00:00	Erith CFC	Er: HFS	402166011	402166011	Eden Aberdeen Angus Beef Roasting Joint (1.5 KG)	95391811068	6
…	…	…	…	…	…	…	…

<tbody>
</tbody>

As you for sure noticed the "Product" on the final file has a different format/id than in the three files "Tpnd" and "SKU". That's because for each product from our costumers we use a specific internal code (Retail code). The match between our suppliers code and our RT codes is made in a different file called "Week Forecast" and has the bellow aspect.

TPND	Code	Description
22918725	RPP001	T GAMMON STKS WT CARMELISED ONION MPQAS
	RPP001CP	TESCO GAMMON STEAK WITH CARMELISED CP
	RPP001WP	WIP TESCO GAMMON STEAK WITH CARMELISED
22918656	RPP002	TESCO BACON CHOPS WT MSTRD BUTTER MPQAS
	RPP002CP	TESCO BACON CHOPS WITH MUSTARD BUTTR CP
	RPP002WP	WIP TESCO BACON CHOPS WITH MUSTARD BUTTR
	RPP003	MARKET VALUE PALE BACK BACON JOINT
	RPP003WP	WIP MARKET VALUE PALE BACK BACON JOINT
	RPP004	MARKET VALUE PALE HAM FILLET
	RPP004WP	WIP MARKET VALUE PALE HAM FILLET
23966061	RPP005	TESCO THICK CUT SMKD RASHERS 250G MPQAS
	RPP005WP	WIP SMOKED THICKCUT BACK BACON RASHERS
23966147	RPP006	TESCO THICKCUT MAPLE RASHERS 250G MPQAS
	RPP006WP	WIP THICKCUT MAPLE BACK BACON RASHERS

<tbody>
</tbody>

Some of the codes are inactive. The only active code is the one in front of the Tpnd code. The macro should match the code from the supplier and pick the correspondent Retail Code to the final file.

Thanks a lot guys!

Kind regards,
Cristian

 

[pbornemeier]

Run the first sub in a new workbook and add data as specified then run the second sub.

Option Explicit

'https://www.mrexcel.com/board/threads/macro-that-takes-data-from-3-files-and-create-a-final-file-with-restrictions.1114051/
Sub SetupWorkbook()
    
    'Run this code in a new workbook
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "ROI"
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "NI"
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Ocado"
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Week Forecast"
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Rename"
    
    'Manually copy data from the ROI, NI & Ocado worksheets to their respective worksheets in this
    '  workbook: ROI, NI, Ocado  (this can be automated if the rest of the code is satisfactory)
    'The "Week Forecast" worksheet should have TPND in the first column, Code in the 2nd column and
    '  Description in the 3rd column
    'The "Rename" worksheet should ahve the long name in the first column and the short name in
    '  the second column.  Ensure no leading or trailing spaces


End Sub

Sub CreateCustomerForecast()
    
    'Manually copy data from the ROI, NI & Ocado worksheets to their respective worksheets in this workbook
    '  ROI, NI, Ocado  (this can be automated if the rest of the code is satisfactory)
    'The "Week Forecast" worksheet should have TPND in the first column, Code in the 2nd column and Description in the 3rd column
    'The "Rename" worksheet should ahve the long name in the first column and the short name in the second column
    
    Dim sWorksheet As String
    Dim lWriteRow As Long
    Dim aryColData(1 To 3, 1 To 5) As Variant
    
    aryColData(1, 1) = "ROI"    'Worksheet Name
    aryColData(1, 2) = 10       'Column holding Depot Name/Place
    aryColData(1, 3) = 6        'Column holding TPND/SKU
    aryColData(1, 4) = 13       'Column holding date
    aryColData(1, 5) = 14       'Column holding case count
    
    aryColData(2, 1) = "NI"
    aryColData(2, 2) = 6
    aryColData(2, 3) = 3
    aryColData(2, 4) = 10
    aryColData(2, 5) = 11
    
    aryColData(3, 1) = "Ocado"
    aryColData(3, 2) = 2
    aryColData(3, 3) = 4
    aryColData(3, 4) = 1
    aryColData(3, 5) = 8
    
    Dim lSheetIndex As Long
    Dim lRowIndex As Long
    Dim lLastRow As Long
    Dim oFound As Object
    Dim lMissingCode As Long
    
    Select Case MsgBox("Open and copy the data from the ROI.csv, NI.xls & Ocado.xls files to their respective worksheets." & vbLf & vbLf & _
        "    OK" & vbTab & " to continue and process data" & vbLf & _
        "    Cancel" & vbTab & " to quit without processing.", vbOKCancel + vbDefaultButton2, "Process Data ? ")
    Case vbCancel
    MsgBox "User Cancelled Operation", , "Exiting"
        GoTo End_Sub
    End Select
    
    'Recreate Output Worksheet
    sWorksheet = "Customer Forecast"
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(sWorksheet).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = sWorksheet 'After last
    
    With Worksheets(sWorksheet)
        .Range("A1").Resize(1, 6).Value = Array("Depot/StoreFormat", "Product", "FactType", "Unit", "Date", "Value")
    End With
    lWriteRow = 2
    
    For lSheetIndex = 1 To UBound(aryColData, 1)
        With Worksheets(aryColData(lSheetIndex, 1))
            lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            For lRowIndex = 2 To lLastRow
                Worksheets(sWorksheet).Cells(lWriteRow, 1) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 2)))
                Worksheets(sWorksheet).Cells(lWriteRow, 2) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 3)))
                Worksheets(sWorksheet).Cells(lWriteRow, 5) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 4)))
                Worksheets(sWorksheet).Cells(lWriteRow, 6) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 5)))
                lWriteRow = lWriteRow + 1
            Next
        End With
    Next
    
    'Modify Output Columns
    With Worksheets(sWorksheet)
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Replace TPND/SKU in column B of 'Customer Forecast' with corresponding value from week forecast worksheet
        '  If TPND/SKU is not found underline and tint cell yellow
        For lRowIndex = 2 To lLastRow
            Set oFound = Worksheets("Week Forecast").Columns("A:A").Find(What:=.Cells(lRowIndex, 2).Value, _
                LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
            If Not oFound Is Nothing Then
                .Cells(lRowIndex, 2).Value = oFound.Offset(0, 1)
            Else
                With .Cells(lRowIndex, 2)
                    .Interior.Color = rgbYellow
                    .Font.Underline = xlUnderlineStyleSingle
                    lMissingCode = lMissingCode + 1
                End With
            End If
            'Update Long Names in column A with short names from 'Rename' worksheet
            Set oFound = Worksheets("Rename").Columns("A:A").Find(What:=.Cells(lRowIndex, 1).Value, _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
            If Not oFound Is Nothing Then
                .Cells(lRowIndex, 1).Value = oFound.Offset(0, 1)
            End If
        Next
        
        .Range("C2:C" & lLastRow).Value = "Customer Forecast"
        .Range("D2:D" & lLastRow).Value = "Cases"
        .Select
    End With
    
    If lMissingCode > 0 Then
        MsgBox lMissingCode & " row(s) do not have a code for their TPND/SKU on the Week Forecast worksheet." & vbLf & vbLf & _
            "They are underlined and tinted yellow.", , "Missing Codes"
    End If
    
End_Sub:

End Sub

 

[Cris_93]

Thank you so much pbornemeier!!

 

[Cris_93]

Hi @pbornemeier,

For some reason when there is no forecast (0 crates) the macro is not picking the date. Could you please help me with that?

I'm also trying to buil up a code to bring the data from three separate files and I will tell you if I can do it!

Thank you,
Cristian

 

[Cris_93]

Hi @pbornemeier !

I created a code that automatically takes the information from the three files and put into the three tabs. What I would like the code to do is to delete the products for which a tpnd code was not found in the Weekly forecast tab. Is that possible? Thanks!

Sub CreateCustomerForecast()

Application.ScreenUpdating = False
repFl = ActiveWorkbook.Name
rpSh = ActiveSheet.Name
Workbooks.Open Filename:= _
"\\IEDRGSFS01\data\Planning\production plans\production plans\Forecast from Tesco Connect\Fresh.xls"
btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
Range("A1:K" & btRw).Select
Selection.Copy
Windows(repFl).Activate
Sheets("ROI").Select
Range("A1:K" & btRw).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
Windows("Fresh.xls").Activate
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = False


Workbooks.Open Filename:= _
"\\IEDRGSFS01\data\Planning\production plans\production plans\Forecast from Tesco Connect\NI.xls"
btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
Range("$A$1:$K$" & btRw).Copy
Windows(repFl).Activate
Sheets("NI").Select
btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
Range("A" & btRw).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
Windows("NI.xls").Activate
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = False


Workbooks.Open Filename:= _
"\\IEDRGSFS01\data\Planning\production plans\production plans\Forecast from Tesco Connect\Ocado.xls"
btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
Range("$A$5:$H$" & btRw).Copy
Windows(repFl).Activate
Sheets("Ocado").Select
btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
Range("A" & btRw).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
Windows("Ocado.xls").Activate
Range("$F$6:$F$" & btRw).Copy
Windows("Ocado.xls").Activate
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = False


Dim sWorksheet As String
Dim lWriteRow As Long
Dim aryColData(1 To 3, 1 To 5) As Variant

aryColData(1, 1) = "ROI" 'Worksheet Name
aryColData(1, 2) = 6 'Column holding Depot Name/Place
aryColData(1, 3) = 3 'Column holding TPND/SKU
aryColData(1, 4) = 10 'Column holding date
aryColData(1, 5) = 11 'Column holding case count

aryColData(2, 1) = "NI"
aryColData(2, 2) = 6
aryColData(2, 3) = 3
aryColData(2, 4) = 10
aryColData(2, 5) = 11

aryColData(3, 1) = "Ocado"
aryColData(3, 2) = 2
aryColData(3, 3) = 4
aryColData(3, 4) = 1
aryColData(3, 5) = 8

Dim lSheetIndex As Long
Dim lRowIndex As Long
Dim lLastRow As Long
Dim oFound As Object
Dim lMissingCode As Long


'Output Worksheet
sWorksheet = "Customer Forecast"
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(sWorksheet).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = sWorksheet 'After last

With Worksheets(sWorksheet)
.Range("A1").Resize(1, 6).Value = Array("Depot/StoreFormat", "Product", "FactType", "Unit", "Date", "Value")
End With
lWriteRow = 2

For lSheetIndex = 1 To UBound(aryColData, 1)
With Worksheets(aryColData(lSheetIndex, 1))
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lRowIndex = 2 To lLastRow
Worksheets(sWorksheet).Cells(lWriteRow, 1) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 2)))
Worksheets(sWorksheet).Cells(lWriteRow, 2) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 3)))
Worksheets(sWorksheet).Cells(lWriteRow, 5) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 4)))
Worksheets(sWorksheet).Cells(lWriteRow, 6) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 5)))
lWriteRow = lWriteRow + 1
Next
End With
Next

'Modifying Output Columns
With Worksheets(sWorksheet)
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'Replace TPND/SKU in column B of 'Customer Forecast' with corresponding value from week forecast worksheet
' If TPND/SKU is not found underline and tint cell yellow
For lRowIndex = 2 To lLastRow
Set oFound = Worksheets("Week Forecast").Columns("A:A").Find(What:=.Cells(lRowIndex, 2).Value, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not oFound Is Nothing Then
.Cells(lRowIndex, 2).Value = oFound.Offset(0, 1)
Else
With .Cells(lRowIndex, 2)
.Interior.Color = rgbYellow
.Font.Underline = xlUnderlineStyleSingle
lMissingCode = lMissingCode + 1
End With
End If
'Update Long Names in column A with short names from 'Rename' worksheet
Set oFound = Worksheets("Rename").Columns("A:A").Find(What:=.Cells(lRowIndex, 1).Value, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not oFound Is Nothing Then
.Cells(lRowIndex, 1).Value = oFound.Offset(0, 1)
End If
Next

.Range("C2:C" & lLastRow).Value = "Customer Forecast"
.Range("D2:D" & lLastRow).Value = "Cases"
.Select
End With

If lMissingCode > 0 Then
MsgBox lMissingCode & " row(s) do not have a code for their TPND/SKU on the Week Forecast worksheet." & vbLf & vbLf & _
"They are underlined and tinted yellow.", , "Missing Codes"
End If

End_Sub:

End Sub

 

[pbornemeier]

I set the forecast crates to 0 in each row of the sample data and I am seeing dates for all of those rows in the output worksheet. Not sure what is happening for your setup.
I added a section of code to clear the Weekly Forecast rows with no TPND
Cleaned up the import routine a bit
If the names or locations of the input files change they can be read from cells on a worksheet so the code does not have to be changed each time.

Option Explicit

'https://www.mrexcel.com/board/threads/macro-that-takes-data-from-3-files-and-create-a-final-file-with-restrictions.1114051/
Sub SetupWorkbook()
    
    'Run this code in a new workbook
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "ROI"
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "NI"
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Ocado"
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Week Forecast"
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Rename"
    
    'Validate names for the ROI, NI & Ocado worksheets as shown in code
    'The "Week Forecast" worksheet should have TPND in the first column, Code in the 2nd column and
    '  Description in the 3rd column
    'The "Rename" worksheet should ahve the long name in the first column and the short name in
    '  the second column.  Ensure no leading or trailing spaces


End Sub

Sub CreateCustomerForecast()
    
    'Manually copy data from the ROI, NI & Ocado worksheets to their respective worksheets in this workbook
    '  ROI, NI, Ocado  (this can be automated if the rest of the code is satisfactory)
    'The "Week Forecast" worksheet should have TPND in the first column, Code in the 2nd column and Description in the 3rd column
    'The "Rename" worksheet should ahve the long name in the first column and the short name in the second column
    
    Dim sWorksheet As String
    Dim lWriteRow As Long
    Dim aryColData(1 To 3, 1 To 5) As Variant
    
    aryColData(1, 1) = "ROI"    'Worksheet Name
    aryColData(1, 2) = 10       'Column holding Depot Name/Place
    aryColData(1, 3) = 6        'Column holding TPND/SKU
    aryColData(1, 4) = 13       'Column holding date
    aryColData(1, 5) = 14       'Column holding case count
    
    aryColData(2, 1) = "NI"
    aryColData(2, 2) = 6        'Column holding Depot Name/Place
    aryColData(2, 3) = 3        'Column holding TPND/SKU
    aryColData(2, 4) = 10       'Column holding date
    aryColData(2, 5) = 11       'Column holding case count
    
    aryColData(3, 1) = "Ocado"
    aryColData(3, 2) = 2        'Column holding Depot Name/Place
    aryColData(3, 3) = 4        'Column holding TPND/SKU
    aryColData(3, 4) = 1        'Column holding date
    aryColData(3, 5) = 8        'Column holding case count
    
    Dim lSheetIndex As Long
    Dim lRowIndex As Long
    Dim lLastRow As Long
    Dim oFound As Object
    Dim lMissingCode As Long
    Dim lLastWFRow As Long
    
    Dim repFl As String
    Dim rpSh As String
    Dim btRw As Long
    Dim wbkImport As Workbook
    
    ThisWorkbook.Activate
    
    Select Case MsgBox("Open and copy the data from the ROI.csv, NI.xls & Ocado.xls files to their respective worksheets." & vbLf & vbLf & _
        "    OK" & vbTab & " to continue and process data" & vbLf & _
        "    Cancel" & vbTab & " to quit without processing.", vbOKCancel + vbDefaultButton2, "Process Data ? ")
    Case vbCancel
    MsgBox "User Cancelled Operation", , "Exiting"
        GoTo End_Sub
    End Select
    
    Application.ScreenUpdating = False
    repFl = ActiveWorkbook.Name
    rpSh = ActiveSheet.Name
    
    'Clear input worksheets
    Worksheets("ROI").Cells.Clear
    Worksheets("NI").Cells.Clear
    Worksheets("Ocado").Cells.Clear
    
    'Import data
    Workbooks.Open Filename:= _
        "\\IEDRGSFS01\data\Planning\production plans\production plans\Forecast from Tesco Connect\Fresh.xls"
    Set wbkImport = ActiveWorkbook
    btRw = Range("A65536").End(xlUp).Row
    Range("A1:N" & btRw).Copy Destination:=Workbooks(repFl).Worksheets("ROI").Range("A1")
    wbkImport.Close savechanges:=False

    Workbooks.Open Filename:= _
        "\\IEDRGSFS01\data\Planning\production plans\production plans\Forecast from Tesco Connect\NI.xls"
    Set wbkImport = ActiveWorkbook
    btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
    Range("A1:K" & btRw).Copy Destination:=Workbooks(repFl).Worksheets("NI").Range("A1")
    wbkImport.Close savechanges:=False

    Workbooks.Open Filename:= _
        "\\IEDRGSFS01\data\Planning\production plans\production plans\Forecast from Tesco Connect\Ocado.xls"
    Set wbkImport = ActiveWorkbook
    btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
    Range("A1:H" & btRw).Copy Destination:=Workbooks(repFl).Worksheets("Ocado").Range("A1")
    wbkImport.Close savechanges:=False

    'Delete Week Forecast rows with no TPND code
    With Worksheets("Week Forecast")
        .AutoFilterMode = False                             'Clear autofilter if it exists
        lLastWFRow = .Cells(.Rows.Count, 2).End(xlUp).Row   'Last populated row in column B
        .UsedRange.AutoFilter Field:=1, Criteria1:="="      'Filter to show rows with blanks in column A
        If Application.WorksheetFunction.Subtotal(3, .Columns(2)) > 1 Then
            'If there is more than one cell visible in column B
            .Range("A2:A" & lLastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete 'Delete visible rows below header
        End If
        .AutoFilterMode = False
    End With
    
    'Recreate Output Worksheet
    sWorksheet = "Customer Forecast"
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(sWorksheet).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = sWorksheet 'After last
    
    With Worksheets(sWorksheet)
        .Range("A1").Resize(1, 6).Value = Array("Depot/StoreFormat", "Product", "FactType", "Unit", "Date", "Value")
    End With
    lWriteRow = 2
    
    For lSheetIndex = 1 To UBound(aryColData, 1)
        With Worksheets(aryColData(lSheetIndex, 1))
            lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            For lRowIndex = 2 To lLastRow
                Worksheets(sWorksheet).Cells(lWriteRow, 1) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 2)))
                Worksheets(sWorksheet).Cells(lWriteRow, 2) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 3)))
                Worksheets(sWorksheet).Cells(lWriteRow, 5) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 4)))
                Worksheets(sWorksheet).Cells(lWriteRow, 6) = Trim(.Cells(lRowIndex, aryColData(lSheetIndex, 5)))
                lWriteRow = lWriteRow + 1
            Next
        End With
    Next
    
    'Modify Output Columns
    With Worksheets(sWorksheet)
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Replace TPND/SKU in column B of 'Customer Forecast' with corresponding value from week forecast worksheet
        '  If TPND/SKU is not found underline and tint cell yellow
        For lRowIndex = 2 To lLastRow
            Set oFound = Worksheets("Week Forecast").Columns("A:A").Find(What:=.Cells(lRowIndex, 2).Value, _
                LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
            If Not oFound Is Nothing Then
                .Cells(lRowIndex, 2).Value = oFound.Offset(0, 1)
            Else
                With .Cells(lRowIndex, 2)
                    .Interior.Color = rgbYellow
                    .Font.Underline = xlUnderlineStyleSingle
                    lMissingCode = lMissingCode + 1
                End With
            End If
            'Update Long Names in column A with short names from 'Rename' worksheet
            Set oFound = Worksheets("Rename").Columns("A:A").Find(What:=.Cells(lRowIndex, 1).Value, _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
            If Not oFound Is Nothing Then
                .Cells(lRowIndex, 1).Value = oFound.Offset(0, 1)
            End If
        Next
        
        .Range("C2:C" & lLastRow).Value = "Customer Forecast"
        .Range("D2:D" & lLastRow).Value = "Cases"
        .Select
        .UsedRange.Columns.AutoFit
    End With
    
    If lMissingCode > 0 Then
        MsgBox lMissingCode & " row(s) do not have a code for their TPND/SKU on the Week Forecast worksheet." & vbLf & vbLf & _
            "They are underlined and tinted yellow.", , "Missing Codes"
    End If
    
End_Sub:

End Sub

 

[Cris_93]

Hi pbornemeier!

Once again thank you so much for your help!

The macro is working perfectly now I just need to make a small adjustment to it and I think is a walk in the park for you. The macro is using US format (mm/dd/yyyy) for all ocado forecast. So for instance 10th of march is stored as 03/10/2020 which is misleading as then our internal software uses dd/mm/yyyy, so for him is 3rd of October. This US format is default for CSV files I believe? How can we force the macro to use european format?

Thank you,
Cristian

 

[pbornemeier]

Rename the .csv file to .txt and open it with notepad to see how the date data is stored in the .txt file. Post few lines here.

(I thought ROI was a .csv and ocado was .xls). If so, save that file as .csv, change it .txt and inspect as above.

As far as I know Excel imports a .csv files based on the current regional settings of the computer. The macro code I provided does not force or assume any particular date format, so it should use regional settings.

If you change the extension to .txt you can import the file as delimited and define the date format required to correctly interpret the dates, You can rename and import the file as part of the importing code if that is necessary.

You might consider ISO 8601

 

[Cris_93]

Hi pbornemeier!

Exactly you are right the Ocado file is .xls but for some reason this happens only with dates at the begining of the month for instance 01/04/2020 from ocado file will appear at 04/01/2020 (see picture bellow).

I believe it has something to do with the way that the format is saved.
but on the formula it appears as dd/mm/yyyyy as bellow:

Workbooks.Open Filename:= _
        "\\IEDRGSFS01\data\Planning\production plans\production plans\Forecast from Tesco Connect\Ocado.xls"
    btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
    Range("A5:H" & btRw).Copy
    Windows(repFl).Activate
    Sheets("Ocado").Select
    btRw = Range("A65536").End(xlUp).Offset(0, 0).Row
    Cells(1, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    Windows("Ocado.xls").Activate
    Range("$F$6:$F$" & btRw).Copy
    Windows("Ocado.xls").Activate
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Application.DisplayAlerts = False
    
    Columns("A:A").Select
   [COLOR=rgb(184, 49, 47)] Selection.NumberFormat = "dd/mm/yyyy"[/COLOR]

 

[pbornemeier]

A "real" date is stored as a whole number in Excel (Today is 43910). How it looks is determined by the regional settings or format as set in Excel (2020 Mar 20 or 20/3/2020 or 20/03/2020 or 03/20/2020 etc.)
As I recall Excel uses regional settings to save and interpret date and time formats (from their underlying numeric value).
Is the computer that is generating the Ocado.xls file set to use a US regional setting?
In Ocado.xls is the column that holds the dates formatted as "General" or "Date" or "Text"?
Save Ocado.xls as Ocado.csv then use notepad to examine row 4893 and see how the date looks as text.