Solved
Flexible lookup formula
Posted on 2003-02-19
Ok, let´s see if I can make this simple..
I got two files. The first one contains orders for one week and there are three columns of interest: Reciever, Booking date and Recieving date.
The second file is a calender with weeks (and Mon-Sun) on the horizontal axis and the recievers on the vertical axis. Each sheet contains 26 weeks, week 1-26 or 27-52 (Sheets named W 27-52 2002, W 1-26 2003…). That is, the first "day" isn´t automatically 1/1. For each reciever there are 6 rows (the recievers are then separated by an empty row) where the top row indicates booking date and the bottom row means receiving date. An order is marked by a index number. See example below.
Week 1
Mon Tue Wed Thu Fri Sat Sun
Booking date 2 3 4
..
..
Receiving date 2 3 4
This Calendar shows when the order is SUPPOSED to be recieved. In the first file, let´s name it LT (Leadtime), I have got the actual receiving dates. This file contains as of today about 700 orderlines but will possibly increase to 3000. A new list is received every week.
Basically what I want to do is to check if the orders have arrived in time, that is on or before the scheduled receiving date, and mark those who have with a 1.
I can easily do this with a For each ..next. But already with these 700 orderlines it takes quite a while, more than a minute and a half, and the users computers are slower than mine. What I need is a formula (or maybe more than one..)
So, I´ve got a constantly growing Calendar (not only number of sheets, recivers may added or deleted so anytime) and a weekly Leadtime workbook.
This not so smooth solution is the closest I´ve reached:
(Column F is reciever, column J is booking date and column M is receiving date)
With Sheets("Orders")
Rows = Application.CountA(.Range("A:A"))
'StartWeek
.Range("N2:N" & Rows).Formula = "=(WEEKNUM(J2)=52)*WEEKNUM(J2)+(WEEKNUM(J2)>52)"
'StartColumn
.Range("O2:O" & Rows).Formula = "=(N2-(N2>26)*26)*7 + 2 - 7 +(WEEKDAY(J2)-1)"
'EndWeek
.Range("P2:P" & Rows).Formula = "=(WEEKNUM(M2)<=52)*WEEKNUM(M2)+(WEEKNUM(M2)>52)"
'EndColumn
.Range("Q2:Q" & Rows).Formula = "=(P2-(P2>26)*26)*7 + 2 - 7 +(WEEKday(M2)-1)"
'Check errorvalues. No sum means error.
.Range("BX1").Formula = "=SUM(R2:R" & Rows & ")"
If IsError(.Range("BX1").Value) = True Then GoTo errorhandler
'StartSheet
.Range("R2:R" & Rows).Formula = "=(YEAR(J2)-2002) * 2 + (N2>=27)"
'EndSheet (might differ from Startsheet!)
.Range("S2:S" & Rows).Formula = "=R2+(P2<N2)*1"
Rad = 2
CalFile = "[Calendar.xls]"
'Writes all sheets in Calendar to column AH
For Each wsSheet In Workbooks(CalFile).Sheets
.Range("AH" & Rad) = wsSheet.Name
Rad = Rad + 1
Next wsSheet
'Names the area
.Range("AH2:AH" & Rad - 1).Name = "SheetName"
'Gives Startsheetname in text
.Range("T2:T" & Rows).Formula = "=INDEX(SheetName, R2)"
'Gives Endsheetname in text
.Range("U2:U" & Rows).Formula = "=INDEX(SheetName, S2)"
'Row
Range("AH1") = CalFile
'Checkarea for row calculation sheet 1
.Range("V2:V" & Rows).Formula = "=CONCATENATE(""'"",$AH$1, T2,""'!$A$1:$A$250"")"
'Checkarea for row calculation sheet 2
.Range("W2:W" & Rows).Formula = "=CONCATENATE(""'"",$AH$1,U2,""'!$A$1:$A$250"")"
’Row booking date
.Range("X2:X" & Rows).Formula = "=MATCH(F2," & .Range("V2").Value & ",0)"
'Row recieving date
.Range("Y2:Y" & Rows).Formula = "=MATCH(F2," & .Range("W2").Value & ",0)"
End With
'Cell for startorderindex
Range("Z2:Z" & Rows).Formula = "=ADDRESS(X2, O2)"
’Cells receiving periods
Range("AA2:AA" & Rows).Formula = "=ADDRESS(X2+5, O2)"
Range("AB2:AB" & Rows).Formula = "=ADDRESS(X2+5, Q2)"
Range("AC2:AC" & Rows).Formula = "=CONCATENATE(""'"",$AH$1, T2,""'!"",Z2)"
Range("AD2:AD" & Rows).Formula = "=CONCATENATE(""'"",$AH$1, T2,""'!"",AA2,"":"",AB2)"
'Range("AD2:AD" & Rows).Formula = "=CONCATENATE(""'"",$AH$1, T2,""'!C""" & Range("X2").Value + 5 & """: GB """ & Range("X2").Value + 5 & ")"
Range("AE2:AE" & Rows).Formula = "=INDIRECT(AC2)"
Range("AF2:AF" & Rows).Formula = "=(O2<=(MATCH(AE2,AD2,0)))*1"
errorhandler:
End Sub
For some %¤&%# reason the MATCH formula doesn´t work. I´ve tried it manually, but a reference (Here: AD2) as search area doesn´t work! Why? Just solving this last bit would do as a solution. A smoother one would be even better.