[![enter image description here][2]][2] This is a sample of K63
So again I want to arrange each worksheet in the workbook based on the values in K4, L4 and than K63
Hello I'm looking for a code that will sort the worksheets in the workbook based on multiple cell values. First I will like to sort all worksheets in the workbook based on K4 (text Ascending Order) than by L4 (text Ascending Order) and finally by cell k63 (value greatest to least). I'm struggling with the logic piece on how to make it vba go in sequence. Any insight will be greatly appreciated.
I hid rows and delete sensitive data. But from the screen shot you can basically get the jist of how I would like the worksheets arranged
CodePudding user response:
The following code shows how you could achieve this:
Create an array of objects that hold the information for every sheet, including the sheet name itself
Sort the array according to your needs. I have used a simple bubble sort as it is fast enough for 100 records - but if you want, feel free to look for more efficient sort algorithms, plenty around here on SO and elsewhere. The key of sorting is that you have a custom compare method that returns -1 if object 1 is "smaller" (needs to be sorted to the left) and 1 if it is "larger" - very similar to the strComp
-method in VBA.
After sorting, use the sheet names of the sorted array to rearrange the sheets.
Create a class module and name it clsSheetData
that holds the information needed for sorting.
Public sheetname As String
Public gmo As String
Public ovp As String
Public percent As Double
Create a regular module with the code (I assume you want to sort ThisWorkbook
, else pass the workbook as parameter)
Sub SortSheets()
' Define the array
ReDim arr(1 To ThisWorkbook.Sheets.Count) As clsSheetData
' - - Step 1: Build array with data
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Set arr(ws.Index) = New clsSheetData
arr(ws.Index).sheetname = ws.Name
arr(ws.Index).gmo = ws.Range("K4")
arr(ws.Index).ovp = ws.Range("L4")
arr(ws.Index).percent = ws.Range("K63")
Next
' - - Step 2: Sort Array (Bubblesort)
Dim i As Long, j As Long
For i = 1 To UBound(arr) - 1
For j = i 1 To UBound(arr)
If sheetCompare(arr(i), arr(j)) > 0 Then
Dim Temp As clsSheetData
Set Temp = arr(j)
Set arr(j) = arr(i)
Set arr(i) = Temp
End If
Next j
Next i
' - - Step3: Rearrange sheets
For i = 1 To UBound(arr)
With ThisWorkbook
.Sheets(arr(i).sheetname).Move before:=.Sheets(i)
End With
Next
End Sub
Function sheetCompare(o1 As clsSheetData, o2 As clsSheetData) As Integer
' Compare the data of 2 sheets.
If o1.gmo <> o2.gmo Then ' If gmo is different, use that as criteria
sheetCompare = StrComp(o1.gmo, o2.gmo, vbTextCompare)
ElseIf o1.ovp <> o2.ovp Then ' Else If ovp is different, use that as criteria
sheetCompare = StrComp(o1.ovp, o2.ovp, vbTextCompare)
Else ' Else, compare percentage
sheetCompare = IIf(o1.percent > o2.percent, -1, 1)
End If
End Function