SOLVED

how to sort worksheets into order by extracting cell info

Copper Contributor

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.Example.JPG

 

 

 

 

2 Replies
best response confirmed by Jamie Sutherland (Copper Contributor)
Solution

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

Thanks for your response,

i guess the formula below is entered into MS Visual Basic, but can you pls be more specific and detail how that is specifically done?

1 best response

Accepted Solutions
best response confirmed by Jamie Sutherland (Copper Contributor)
Solution

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

View solution in original post