Sub filterDay()
'macro to change shipping sheet
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer
Dim n As Integer
Dim ordrList As Range
Dim findValue As Range
Dim addMe As Range
Dim brdRange As Range
Dim ordSht As Worksheet
Dim dshBoard As Worksheet
Dim myarray As Variant
Dim tday As Date
On Error GoTo errHandler:
Application.ScreenUpdating = False
Set ordSht = Sheet3
Set dshBoard = Sheet1
ordSht.Range("S1").value = "Ship Date"
ordSht.Range("S2").value = Sheet1.Range("V1")
ordSht.Range("A2:L1048576").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
ordSht.Range("$S$1:$S$2"), CopyToRange:=ordSht.Range("$U$1:$AF$1"), Unique:=False
ordSht.Select
With ordSht
.Range("U2:AF1048576").Sort Key1:=Range("AB2"), Order1:=xlAscending, Header:=xlGuess
End With
Set ordrList = Sheet3.Range("outdata")
myarray = ordrList
i = Sheet3.Range("T1").value
For j = 1 To i
Set addMe = dshBoard.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Set findValue = ordSht.Range("A:A").Find(What:=myarray(j, 1), _
LookIn:=xlValues, lookat:=xlWhole)
x = findValue.Offset(0, 12).value
n = 0
addMe.value = myarray(j, 3) 'customer
addMe.Offset(0, 15).value = Evaluate("=INDEX(CustomerTable[Salesperson],MATCH(""" & addMe.value & """,CustomerTable[Customer],0))") 'salesperson
addMe.Offset(0, 16).value = myarray(j, 9) ' delivery method
addMe.Offset(0, 17).value = myarray(j, 8) ' ship time
addMe.Offset(0, 17).NumberFormat = "h:mm AM/PM"
For y = 2 To x
addMe.Offset(n, 1).value = findValue.Offset(y, 0).value 'product
addMe.Offset(n, 2).value = findValue.Offset(y, 2).value 'cases
addMe.Offset(n, 3).value = findValue.Offset(y, 3).value 'pack size
addMe.Offset(n, 4).value = findValue.Offset(y, 4).value 'Staging
addMe.Offset(n, 5).value = findValue.Offset(y, 5).value 'assortment
addMe.Offset(n, 6).value = findValue.Offset(y, 6).value 'colour
addMe.Offset(n, 7).value = findValue.Offset(y, 7).value 'cover
addMe.Offset(n, 8).value = findValue.Offset(y, 8).value 'ornament
addMe.Offset(n, 9).value = findValue.Offset(y, 9).value 'upc
addMe.Offset(n, 10).value = findValue.Offset(y, 10).value 'caretag
addMe.Offset(n, 11).value = findValue.Offset(y, 11).value 'insulation
addMe.Offset(n, 12).value = findValue.Offset(y, 12).value 'sleeve
addMe.Offset(n, 13).value = findValue.Offset(y, 13).value 'notes
addMe.Offset(n, 14).value = findValue.Offset(y, 14).value 'box label
'formatting
addMe.Offset(n, 1).VerticalAlignment = xlCenter
With addMe.Offset(0, 2).Resize(x - 1, 14)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
addMe.Offset(n, 6).WrapText = True
addMe.Offset(n, 13).WrapText = True
n = n + 1
Next y
addMe.Offset(x - 1, 0).value = "no one can see this :)"
With addMe.Offset(x - 1, 0).EntireRow.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
End With
addMe.Resize(x - 1).Merge
With addMe
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
.WrapText = True
End With
With addMe.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With
addMe.Offset(0, 15).Resize(x - 1).Merge
With addMe.Offset(0, 15)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
.WrapText = True
End With
addMe.Offset(0, 16).Resize(x - 1).Merge
With addMe.Offset(0, 16)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
.WrapText = True
End With
addMe.Offset(0, 17).Resize(x - 1).Merge
With addMe.Offset(0, 17)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
.WrapText = True
End With
With addMe.Resize(x - 1, 18).Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
Next j
Sheet1.Select
Exit Sub
errHandler:
Sheet1.Select
MsgBox "No orders are in the system for the selected date.", vbOKOnly + vbInformation, "No Orders Found"
End Sub