Hello All. can you experts please help me with the following query? i have tasks set up on worksheets - 40 separate tasks equals 40 separate worksheets. Cell C1 on each worksheet is a Date Cell B1 is three years on from that Date. EG Cell C1 = a date, say 7 March 2018 and Cell B1 =SUM(C1+1095) this is the same formula for all of my 40 worksheets.
i want to be able to do the following: 1. put all the 40 worksheets in high to low order (EG Cell B1 order) so that the oldest Due Date job is now the first worksheet and, 2. perhaps make a separate worksheet that displays the (a) name of the sheet and (b) the days left, in descending order.
i hope this make sense - i have attached an jpg showing what the cells look like on my worksheet. i look forward to hearing some advice. thank you.
Sub ReArrangeWorksheets() 'Jim Cone - March 2018 - https://goo.gl/IUQUN2 Dim arrNum() As Variant Dim arrName() As String Dim N As Long Dim M As Long Dim P As Double
With ThisWorkbook ReDim arrNum(1 To .Worksheets.Count) ReDim arrName(1 To .Worksheets.Count) For N = LBound(arrNum) To UBound(arrNum) arrNum(N) = .Worksheets(N).Range("B1").Value2 If VBA.Val(arrNum(N)) < 1 Then MsgBox "Check worksheet: " & .Worksheets(N).Name & " ", _
vbExclamation, "Arrange Worksheets " Exit Sub End If arrName(N) = .Worksheets(N).Name Next
For N = LBound(arrNum) To UBound(arrNum) P = Application.WorksheetFunction.Min(arrNum) M = Application.WorksheetFunction.Match(P, arrNum, False) arrNum(M) = 99000 + N .Worksheets(arrName(M)).Move after:=.Worksheets(.Worksheets.Count) Next End With End Sub