Help required in creating a logical layout from reading in from a table

Jat999

New Member
Joined
May 7, 2016
Messages
49
Hi all

I have been developing a spreadsheet for our planning team, which is almost as we want it. However I am struggling on finer points of the final layout.

The raw data is imported from an ERP system via SQL into a table in Excel. The data table has 16 columns of elements such as Product name and description, order number, production resource start date, quantity etc.
As part of the import procedure, I pre sort the data before writing into the spreadsheet by the following:-
Production resource (Unit) - Start Date - Item description (A-Z)

The data is then read into the spreadsheet to look something like below
1579949150750.png


My problem is highlighted on the above view where Production line 2 I have 2 products repeated in the rows.
If I remove the start date from the sort sequence, this now brings all the orders across the days onto the same product description however now I no longer get the logical sequence of first product on a monday etc. Below is the result of removing the Start Date from the sort sequence
1579950007004.png


My Ideal layout would be as below:

1579950199459.png


The code I am using to read in the data onto the spreadsheet is as follow:

Public Sub Populate()

Dim wbkReference As Workbook
Dim lws As Worksheet
Dim lsLine As String ' Production line code
Dim PrvlsLine As String ' Previous Production line code
Dim lsInputLine As String ' A Line from the data file
Dim lsProductCode As String ' Product code of current run
Dim PrvlsProductCode As String ' Previous Product code of current run
Dim lnMins As Variant ' Run length in Minutes
Dim lsProductName As String ' Product name at start of run
Dim lnQuantity As Variant ' Quantity produced (Cases) may be null if size change
Dim lnLandedQuant As Variant
Dim lsOrderNum As String ' Product code of current run
Dim lsDayOfWeek As String
Dim lsAllergens As String
Dim lsComments As String
Dim lcCount As Integer
Dim OverallLastRow As Long
Dim J_Date As Integer
Dim WESatCount As Long
Dim WESunCount As Long
Dim AMShift As String
Dim PMShift As String
Dim PrvlsDayOfWeek As String
Dim CellCol As Long


Set wbkReference = Me

Worksheets(Worksheets("Start").Range("K9").Text).Activate
Set lws = ActiveSheet

PrvlsProductCode = ""
PrvlsLine = ""


'Read data into Worksheet
ActiveSheet.Range("A1").Select
ActiveWindow.FreezePanes = False
ActiveSheet.Range("A:v").Cells.Clear
ActiveSheet.Buttons.Delete
J_Date = Worksheets("Start").Range("Julien_Date").Value



Set tbl = wbkReference.Worksheets("Production_Order").ListObjects("Item_Master_Table")
SchedArray = tbl.DataBodyRange

With ActiveSheet
.Cells(1, 1).Value = "Production Plan"
.Cells(1, 2).Value = Range("StartDate").Value
.Cells(1, 3).Value = "Week Number"
.Cells(1, 4).Value = Range("WeekNumber").Value
.Cells(2, 1).Value = "Unit"
.Cells(2, 2).Value = "SAP Code"
.Cells(2, 3).Value = "SAP Description"
.Cells(2, 4).Value = "Notes / Comments"
.Cells(2, 5).Value = "Allergens"
.Cells(2, 6).Value = "Julien Date"
.Cells(1, 7).Value = Range("StartDate").Value
.Cells(1, 7).NumberFormat = "ddd - dd/mm/yy"
.Cells(1, 9).Value = Range("StartDate").Value + 1
.Cells(1, 9).NumberFormat = "ddd - dd/mm/yy"
.Cells(1, 11).Value = Range("StartDate").Value + 2
.Cells(1, 11).NumberFormat = "ddd - dd/mm/yy"
.Cells(1, 13).Value = Range("StartDate").Value + 3
.Cells(1, 13).NumberFormat = "ddd - dd/mm/yy"
.Cells(1, 15).Value = Range("StartDate").Value + 4
.Cells(1, 15).NumberFormat = "ddd - dd/mm/yy"
.Cells(1, 17).Value = Range("StartDate").Value + 5
.Cells(1, 17).NumberFormat = "ddd - dd/mm/yy"
.Cells(1, 19).Value = Range("StartDate").Value + 6
.Cells(1, 19).NumberFormat = "ddd - dd/mm/yy"
.Cells(1, 21).Value = "Total"
.Cells(1, 22).Value = "Total"
.Cells(2, 21).Value = "Planned Quantity"
.Cells(2, 22).Value = "Completed Quantity"
.Cells(2, 7).Value = J_Date
.Cells(2, 7).NumberFormat = "000"
.Cells(2, 9).Value = J_Date + 1
.Cells(2, 9).NumberFormat = "000"
.Cells(2, 11).Value = J_Date + 2
.Cells(2, 11).NumberFormat = "000"
.Cells(2, 13).Value = J_Date + 3
.Cells(2, 13).NumberFormat = "000"
.Cells(2, 15).Value = J_Date + 4
.Cells(2, 15).NumberFormat = "000"
.Cells(2, 17).Value = J_Date + 5
.Cells(2, 17).NumberFormat = "000"
.Cells(2, 19).Value = J_Date + 6
.Cells(2, 19).NumberFormat = "000"




End With
WESatCount = 0
WESunCount = 0
y = 4

For x = LBound(SchedArray) + 1 To UBound(SchedArray)

If tbl.Range(x, 8).Value = "" Then

Else
lsProductCode = tbl.Range(x, 1).Value
lsOrderNum = tbl.Range(x, 2).Value
lnQuantity = tbl.Range(x, 3).Value
ldtStartDate = tbl.Range(x, 7).Value
lnMins = tbl.Range(x, 6).Value
lsLine = tbl.Range(x, 8).Value
lsProductName = tbl.Range(x, 9).Value
lsDayOfWeek = tbl.Range(x, 10).Value
lsAllergens = tbl.Range(x, 12).Value
lsComments = tbl.Range(x, 13).Value
lnLandedQuant = tbl.Range(x, 14).Value
AMShift = tbl.Range(x, 15).Value
PMShift = tbl.Range(x, 16).Value


If lsLine = tbl.Range(x - 1, 8).Value Then
lcCount = 1
Else: lcCount = 0
End If

Z = 7

If lsDayOfWeek = "Tuesday" Then
Z = Z + 2


ElseIf lsDayOfWeek = "Wednesday" Then
Z = Z + 4


ElseIf lsDayOfWeek = "Thursday" Then
Z = Z + 6

ElseIf lsDayOfWeek = "Friday" Then
Z = Z + 8

ElseIf lsDayOfWeek = "Saturday" Then
Z = Z + 10
WESatCount = WESatCount + 1

Else
If lsDayOfWeek = "Sunday" Then
Z = Z + 12
WESunCount = WESunCount + 1

End If
End If

With ActiveSheet

If lsProductCode = PrvlsProductCode And lsLine = PrvlsLine And lsDayOfWeek = PrvlsDayOfWeek Then

' y = y + 2

.Cells(y - 1, Z) = lsOrderNum
.Cells(y, 2) = lsProductCode ' Product Code
.Cells(y, 3) = lsProductName
.Cells(y, 4) = lsComments
.Cells(y, 5) = lsAllergens
.Cells(y - 1, 6).Value = "Works Order"
.Cells(y, Z) = lnQuantity
.Cells(y, Z + 1) = lnLandedQuant
.Cells(y, 21).Formula = "=Sum(G" & y & ",I" & y & ",K" & y & ",M" & y & ",O" & y & ",Q" & y & ",S" & y & ")"
.Cells(y, 22).Formula = "=Sum(H" & y & ",J" & y & ",L" & y & ",N" & y & ",P" & y & ",R" & y & ",T" & y & ")"


Else

If lsProductCode = PrvlsProductCode And lsLine = PrvlsLine Then
y = y - 2

CellVal = .Cells(y, Z).Value
.Cells(y, Z) = lnQuantity
.Cells(y - 1, Z) = lsOrderNum
.Cells(y, Z + 1) = lnLandedQuant
Else


.Cells(y - 1, Z) = lsOrderNum
.Cells(y, 2) = lsProductCode ' Product Code
.Cells(y, 3) = lsProductName
.Cells(y, 4) = lsComments
.Cells(y, 5) = lsAllergens
.Cells(y - 1, 6).Value = "Works Order"
.Cells(y, Z) = lnQuantity
.Cells(y, Z + 1) = lnLandedQuant
.Cells(y, 21).Formula = "=Sum(G" & y & ",I" & y & ",K" & y & ",M" & y & ",O" & y & ",Q" & y & ",S" & y & ")"
.Cells(y, 22).Formula = "=Sum(H" & y & ",J" & y & ",L" & y & ",N" & y & ",P" & y & ",R" & y & ",T" & y & ")"
End If

End If

If lcCount = 0 Then
.Cells(y - 1, 1) = lsLine
' ThisWorkbook.Worksheets("Scratch").Cells(y - 1, 1).Value = ""
End If

If AMShift = "Y" Then
CellCol = RGB(220, 230, 241)
ElseIf PMShift = "Y" Then
CellCol = RGB(252, 213, 180)
Else
CellCol = RGB(255, 255, 255)
End If



With Range(Cells(y - 1, Z), Cells(y, Z + 1))

.Interior.Color = CellCol

End With

End With

PrvlsProductCode = lsProductCode
PrvlsLine = lsLine
PrvlsDayOfWeek = lsDayOfWeek

y = y + 2


End If
lcCount = 0
Next x
End Sub

I apologise for the long post but looking forward to some solutions

John
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Not quite sure this will help, but my instinct would be to import the data via Powerquery and then display it with PowerPivot, if it works it will be easier to maintain and simpler to build. But without raw data I'm not sure.
 
Upvote 0
Not quite sure this will help, but my instinct would be to import the data via Powerquery and then display it with PowerPivot, if it works it will be easier to maintain and simpler to build. But without raw data I'm not sure.
Hi Peter

Thanks for the prompt reply. Unfortunately the file will be made available for all employees on a shared drive. I would not be able to manage access and support for using advanced tools such as PowerPivot, it is not with the company policy to roll out the more advanced tools.
The macro and formatting works well, its just the minor things such as above I need to nail.

John
 
Upvote 0
:) I've worked for a large company where IT don't understand what they're managing. Neither PowerPivot nor PowerQuery are really advanced tools, they're simply the next generation of Excel and link into PowerBI - a game changer and money saver for most organisations!! Apologies, but I hope someone else can assist with modifying your code. Good Luck.
 
Upvote 0

Forum statistics

Threads
1,214,520
Messages
6,120,013
Members
448,935
Latest member
ijat

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