Home > OS >  Sort Worksheets based on multiple cell values
Sort Worksheets based on multiple cell values

Time:08-20

enter image description here This is a sample of K4 L4

[![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.

enter image description here

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
  • Related