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

Cris_93

Cris_93

New Member
Joined
Nov 1, 2019
Messages
22
Office Version
  1. 2016
Platform
  1. Windows
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.


[TABLE="width: 0"]
<tbody>[TR]
[TD]Depot/StoreFormat
[/TD]
[TD]Product
[/TD]
[TD]FactType
[/TD]
[TD]Unit
[/TD]
[TD]Date
[/TD]
[TD]Value
[/TD]
[/TR]
[TR]
[TD]Dublin
[/TD]
[TD]RTP088
[/TD]
[TD]Customer Forecast
[/TD]
[TD]Cases
[/TD]
[TD]02/11/2019
[/TD]
[TD]23
[/TD]
[/TR]
[TR]
[TD]Belfast
[/TD]
[TD]RTB222
[/TD]
[TD]Customer Forecast
[/TD]
[TD]Cases
[/TD]
[TD]12/11/2019
[/TD]
[TD]32
[/TD]
[/TR]
[TR]
[TD]Hatfield
[/TD]
[TD]RTP088
[/TD]
[TD]Customer Forecast
[/TD]
[TD]Cases
[/TD]
[TD]07/11/2019
[/TD]
[TD]30
[/TD]
[/TR]
[TR]
[TD]Dordon
[/TD]
[TD]RTL008
[/TD]
[TD]Customer Forecast
[/TD]
[TD]Cases
[/TD]
[TD]05/11/2019
[/TD]
[TD]30
[/TD]
[/TR]
[TR]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[/TR]
</tbody>[/TABLE]

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"

[TABLE="width: 1541"]
<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>[TR]
[TD="align: center"]Supplier number[/TD]
[TD="align: center"]Category area[/TD]
[TD="align: center"]Star line[/TD]
[TD="align: center"]Tpnb[/TD]
[TD="align: center"]Description[/TD]
[TD="align: center"]Tpnd[/TD]
[TD="align: center"]Case size[/TD]
[TD="align: center"]Occ[/TD]
[TD="align: center"]Depot number[/TD]
[TD="align: center"]Depot name[/TD]
[TD="align: center"]Forecast date[/TD]
[TD="align: center"]Order date[/TD]
[TD="align: center"]Delivery date[/TD]
[TD="align: center"]Forecast cases[/TD]
[/TR]
[TR]
[TD="align: center"]5997500[/TD]
[TD="align: center"]MFP[/TD]
[TD="align: center"]N [/TD]
[TD="align: center"]52440995[/TD]
[TD="align: center"]PORK MINCE 500G[/TD]
[TD="align: center"]31411873[/TD]
[TD="align: center"]8[/TD]
[TD="align: center"]5.05E+12[/TD]
[TD="align: center"]735[/TD]
[TD="align: center"]BALLYMUN FRESH PBL [/TD]
[TD="align: center"]03/10/2019[/TD]
[TD="align: center"]04/10/2019[/TD]
[TD="align: center"]05/10/2019[/TD]
[TD="align: center"]40[/TD]
[/TR]
[TR]
[TD="align: center"]5997500[/TD]
[TD="align: center"]MFP[/TD]
[TD="align: center"]N [/TD]
[TD="align: center"]52445008[/TD]
[TD="align: center"] IRISH LAMB MINCE 15% FAT 533G[/TD]
[TD="align: center"]37216980[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]5.06E+12[/TD]
[TD="align: center"]735[/TD]
[TD="align: center"]BALLYMUN FRESH PBL [/TD]
[TD="align: center"]03/10/2019[/TD]
[TD="align: center"]04/10/2019[/TD]
[TD="align: center"]07/10/2019[/TD]
[TD="align: center"]10[/TD]
[/TR]
[TR]
[TD="align: center"]5997500[/TD]
[TD="align: center"]MFP[/TD]
[TD="align: center"]N [/TD]
[TD="align: center"]52483552[/TD]
[TD="align: center"]T. ROUND STEAK BEEF MINCE 10% FAT 554G[/TD]
[TD="align: center"]34945576[/TD]
[TD="align: center"]12[/TD]
[TD="align: center"]5.06E+12[/TD]
[TD="align: center"]735[/TD]
[TD="align: center"]BALLYMUN FRESH PBL [/TD]
[TD="align: center"]03/10/2019[/TD]
[TD="align: center"]16/10/2019[/TD]
[TD="align: center"]17/10/2019[/TD]
[TD="align: center"]102[/TD]
[/TR]
[TR]
[TD="align: center"]5997500[/TD]
[TD="align: center"]MFP[/TD]
[TD="align: center"]N [/TD]
[TD="align: center"]63755738[/TD]
[TD="align: center"]T. FIN* IRISH CANADIAN MAPLE RASHERS 240G[/TD]
[TD="align: center"]32607750[/TD]
[TD="align: center"]8[/TD]
[TD="align: center"]5.06E+12[/TD]
[TD="align: center"]735[/TD]
[TD="align: center"]BALLYMUN FRESH PBL [/TD]
[TD="align: center"]03/10/2019[/TD]
[TD="align: center"]21/10/2019[/TD]
[TD="align: center"]22/10/2019[/TD]
[TD="align: center"]48[/TD]
[/TR]
[TR]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[TD="align: center"]…[/TD]
[/TR]
</tbody>[/TABLE]

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

"NI.xls"

[TABLE="width: 0"]
<tbody>[TR]
[TD]Supplier number
[/TD]
[TD]Occ
[/TD]
[TD]Tpnd
[/TD]
[TD]Description
[/TD]
[TD]Depot number
[/TD]
[TD]Depot name
[/TD]
[TD]Case size
[/TD]
[TD]Forecast date
[/TD]
[TD]Order date
[/TD]
[TD]Delivery date
[/TD]
[TD]Forecast cases
[/TD]
[/TR]
[TR]
[TD]6242200
[/TD]
[TD]2.0955E+11
[/TD]
[TD] 28798712
[/TD]
[TD]T.FIN 1 BEEF RIBEYE STEAK
[/TD]
[TD]835
[/TD]
[TD]NI BELFAST FRESH PBL
[/TD]
[TD]12
[/TD]
[TD]03/10/2019
[/TD]
[TD]19/10/2019
[/TD]
[TD]21/10/2019
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]6242200
[/TD]
[TD]2.0955E+11
[/TD]
[TD]28798712
[/TD]
[TD]T.FIN 1 BEEF RIBEYE STEAK
[/TD]
[TD]835
[/TD]
[TD]NI BELFAST FRESH PBL
[/TD]
[TD]12
[/TD]
[TD]03/10/2019
[/TD]
[TD]10/10/2019
[/TD]
[TD]11/10/2019
[/TD]
[TD]8
[/TD]
[/TR]
[TR]
[TD]6242200
[/TD]
[TD]2.0955E+11
[/TD]
[TD]28798712
[/TD]
[TD]T.FIN 1 BEEF RIBEYE STEAK
[/TD]
[TD]835
[/TD]
[TD]NI BELFAST FRESH PBL
[/TD]
[TD]12
[/TD]
[TD]03/10/2019
[/TD]
[TD]05/10/2019
[/TD]
[TD]07/10/2019
[/TD]
[TD]21
[/TD]
[/TR]
[TR]
[TD]6242200
[/TD]
[TD]2.0955E+11
[/TD]
[TD]28798712
[/TD]
[TD]T.FIN 1 BEEF RIBEYE STEAK
[/TD]
[TD]835
[/TD]
[TD]NI BELFAST FRESH PBL
[/TD]
[TD]12
[/TD]
[TD]03/10/2019
[/TD]
[TD]09/10/2019
[/TD]
[TD]10/10/2019
[/TD]
[TD]9
[/TD]
[/TR]
[TR]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]…
[/TD]
[TD]...
[/TD]
[/TR]
</tbody>[/TABLE]
The Depot name "NI BELFAST FRESH PBL" should be picked as "Belfast" to the final file;

"Ocado.xls"

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

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.


[TABLE="width: 0"]
<tbody>[TR]
[TD]TPND
[/TD]
[TD]Code
[/TD]
[TD]Description
[/TD]
[/TR]
[TR]
[TD]22918725
[/TD]
[TD]RPP001
[/TD]
[TD]T GAMMON STKS WT CARMELISED ONION MPQAS
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP001CP
[/TD]
[TD] TESCO GAMMON STEAK WITH CARMELISED CP
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP001WP
[/TD]
[TD]WIP TESCO GAMMON STEAK WITH CARMELISED
[/TD]
[/TR]
[TR]
[TD]22918656
[/TD]
[TD]RPP002
[/TD]
[TD]TESCO BACON CHOPS WT MSTRD BUTTER MPQAS
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP002CP
[/TD]
[TD]TESCO BACON CHOPS WITH MUSTARD BUTTR CP
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP002WP
[/TD]
[TD]WIP TESCO BACON CHOPS WITH MUSTARD BUTTR
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP003
[/TD]
[TD]MARKET VALUE PALE BACK BACON JOINT
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP003WP
[/TD]
[TD]WIP MARKET VALUE PALE BACK BACON JOINT
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP004
[/TD]
[TD]MARKET VALUE PALE HAM FILLET
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP004WP
[/TD]
[TD]WIP MARKET VALUE PALE HAM FILLET
[/TD]
[/TR]
[TR]
[TD]23966061
[/TD]
[TD]RPP005
[/TD]
[TD]TESCO THICK CUT SMKD RASHERS 250G MPQAS
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP005WP
[/TD]
[TD]WIP SMOKED THICKCUT BACK BACON RASHERS
[/TD]
[/TR]
[TR]
[TD]23966147
[/TD]
[TD]RPP006
[/TD]
[TD]TESCO THICKCUT MAPLE RASHERS 250G MPQAS
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]RPP006WP
[/TD]
[TD]WIP THICKCUT MAPLE BACK BACON RASHERS
[/TD]
[/TR]
</tbody>[/TABLE]

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
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
Run the first sub in a new workbook and add data as specified then run the second sub.

VBA Code: 
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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.

VBA Code: 
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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).

1584633347890.png


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:

VBA Code: 
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]
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Cris_93
  • Locked
  • Question Question
Macro to built final file from 3 different files
Replies
1
Views
590
Fluff
Fluff

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

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