sorting tables

jenniferRI

New Member
Joined
Jan 11, 2022
Messages
9
Office Version
  1. 2016
Platform
  1. Windows
I have several tables in several sheets, they have in common several columns but each table has a different number of columns. I used formulas to copy the shared data and I fill the othe data manually.
My objectives are the following:

1) Each time I change the value of the included in registry field in overview sheet, I want to automatically reorder all the tables accordingly (put all included patients first) and also according to the value precised in the drop down box.

2) Use the sort button to sort all the data according to the value of the drop down box.

for the first objective I was able to reorder the data automatically in the overview sheet, so in this case the common columns in the other sheets are ordered however the data I filled manually don't change their order. and I did it without taking into consideration the value of the drop down box (I chose patient ID in the macro code)
for the second objective I couldn't do it

Thank you so much for you help,

I am puting here only 3 sheets to understand more what I have
Overview sheet:
registry_test.xlsm
ABCDEFGHIJKLMNOPQR
2
3Patient IDRegistry IDPatient InitialsDate Of BirthSexIncluded in RegistryInformed ConsentCenterDate ABPM InclusionBase CompletedMedical History CompletedMedication CompletedOffice BP CompletedABPM CompletedLaboratory Results CompletedFollow Up Completed
41694210LM10/18/1970FY12/28/2017YYYNNYN
516943100RA10/1/1979MY9/8/2020NY00000
616947105RN10/18/1970FY12/28/2017NNYNYYY
716948108SA5/20/1979FY3/30/2019Y000000
816945102RB12/14/1965MN0000000
916950110SM3/9/1979MN0000000
1016955115ZD10/10/1972FN0000000
Overview
Cell Formulas
RangeFormula
J4:J10J4=IFERROR(VLOOKUP([@[Patient ID]],Table2,12,FALSE),"")
K4:K10K4=IFERROR(VLOOKUP([@[Patient ID]],Table3,36,FALSE),"")
L4:L10L4=IFERROR(VLOOKUP([@[Patient ID]],Table4,26,FALSE),"")
M4:M10M4=IFERROR(VLOOKUP([@[Patient ID]],Table6,19,FALSE),"")
N4:N10N4=IFERROR(VLOOKUP([@[Patient ID]],Table7,13,FALSE),"")
O4:O10O4=IFERROR(VLOOKUP([@[Patient ID]],Table8,34,FALSE),"")
P4:P10P4=IFERROR(VLOOKUP([@[Patient ID]],Table9,29,FALSE),"")
Cells with Conditional Formatting
CellConditionCell FormatStop If True
A4:P300Expression=$F4="N"textNO
J:PCell Value="N"textNO
J:PCell Value="Y"textNO
Cells with Data Validation
CellAllowCriteria
F4:G10ListY,N


Base Sheet:
registry_test.xlsm
ABCDEFGHIJKLM
3Patient IDRegistry IDPatient InitialsDate Of BirthSexAge at time of measurementEthnicityWeight (kg)Height (cm)BMI (kg/m²)Body Surface Area DuBois (m²)Base Completed
41694210LM10/18/1970F47Other5814926.124951.51837Y
516943100RA10/1/1979M415115521.227891.479342N
616947105RN10/18/1970F477816827.636051.878668N
716948108SA5/20/1979F406317221.295291.745173Y
816945102RB12/14/1965M  0
916950110SM3/9/1979M  0
1016955115ZD10/10/1972F  0
Base
Cell Formulas
RangeFormula
A4:A10A4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,1,FALSE),"")
B4:B10B4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,2,FALSE),"")
C4:C10C4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,3,FALSE),"")
D4:D10D4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,4,FALSE),"")
E4:E10E4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,5,FALSE),"")
F4:F10F4=IF(YEAR(Table1[@[Date ABPM Inclusion]])-YEAR(Table1[@[Date Of Birth]])<0,"",YEAR(Table1[@[Date ABPM Inclusion]])-YEAR(Table1[@[Date Of Birth]]))
J4:J10J4=IFERROR([@[Weight (kg)]]/(([@[Height (cm)]]/100)*([@[Height (cm)]]/100)),"")
K4:K10K4=IFERROR(0.20247*([@[Height (cm)]]/100)^0.725*[@[Weight (kg)]]^0.425,"")
Cells with Conditional Formatting
CellConditionCell FormatStop If True
A4:L300Expression=Overview!$F4="N"textNO
K1:K2,K301:K1048576,L3:L300Cell Value="N"textNO
K1:K2,K301:K1048576,L3:L300Cell Value="Y"textNO
Cells with Data Validation
CellAllowCriteria
L4:L10ListY, N
G4:G10ListAfrican, Asian, Caucasian, Hispanic, Other, Unknown


Medication sheet:
registry_test.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAA
3Patient IDRegistry IDPatient InitialsDate Of BirthSexCurrent use of antihypertensive drugsDiureticsDiuretics LoopDiurectis ThiazideDiuretics Potassium-sparingCentrally actingCCB - dihCCB - non-dihACE InhibitorsARBLCZ696VasodilatorsRenin inhibitorsAlpha blockersBeta blockersStatinsNitrovasodilators***Oral AnticoagulantsOther Antithrombotic drugsMedication Complete
41694210LM10/18/1970FY
516943100RA10/1/1979M
616947105RN10/18/1970FY
716948108SA5/20/1979F
816945102RB12/14/1965M
916950110SM3/9/1979M
1016955115ZD10/10/1972F
Medication
Cell Formulas
RangeFormula
A4:A10A4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,1,FALSE),"")
B4:B10B4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,2,FALSE),"")
C4:C10C4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,3,FALSE),"")
D4:D10D4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,4,FALSE),"")
E4:E10E4=IFERROR(VLOOKUP(Table1[Patient ID],Table1,5,FALSE),"")
Cells with Conditional Formatting
CellConditionCell FormatStop If True
A4:Z300Expression=Overview!$F4="N"textNO
Z:ZCell Value="N"textNO
Z:ZCell Value="Y"textNO
Cells with Data Validation
CellAllowCriteria
F4:F300ListY, N
G4:Y300ListY, N, UNK
Z4:Z300ListY, N
 
I have adapted the code to work with tables, I had to add an index field onto the end of each table but you can just hide the column, you will change table names & copy certain parts of the code for additional sheets/tables.

New Sub TestSort Code

VBA Code:
Sub TestSort()
Dim LastRow As Long, LastRow1 As Long, LastRow2 As Long
Dim LastCol As Long, LastCol1 As Long, LastCol2 As Long
Dim S As String, t As String, u As String
Dim h As Long, i As Long

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    LastRow = FindLastRow(Sheets("Overview").Cells)
    LastCol = FindLastcolumn(Sheets("Overview").Cells)
    S = ConvertToLetter(LastCol)
    
    If Range("C1") = "Patient ID" Then
       srt_Patient_ID
    ElseIf Range("C1") = "Registry ID" Then
       srt_Registry_ID
    ElseIf Range("C1") = "Patient Initials" Then
       srt_Patient_Initials
    ElseIf Range("C1") = "Date Of Birth" Then
       srt_Date_Of_Birth
    ElseIf Range("C1") = "Sex" Then
       srt_Sex
    ElseIf Range("C1") = "Informed Consent" Then
       srt_Informed_Consent
    ElseIf Range("C1") = "Center" Then
       srt_Center
    ElseIf Range("C1") = "Date ABPM Inclusion" Then
       srt_Date_ABPM_Inclusion
    ElseIf Range("C1") = "Base Completed" Then
       srt_Base_Completed
    ElseIf Range("C1") = "Medical History Completed" Then
       srt_Medical_History_Completed
    ElseIf Range("C1") = "Medication Completed" Then
       srt_Medication_Completed
    ElseIf Range("C1") = "Office BP Completed" Then
       srt_Office_BP_Completed
    ElseIf Range("C1") = "ABPM Completed" Then
       srt_ABPM_Completed
    ElseIf Range("C1") = "Laboratory Results Completed" Then
       srt_Laboratory_Results_Completed
    ElseIf Range("C1") = "Follow Up Completed" Then
       srt_Follow_Up_Completed
    End If

    srt_Overview_Included_in_Registry
        
    i = 1
    
    For h = 4 To LastRow
        Range(S & h) = i
        i = i + 1
    Next h
    
    Sheets("Base").Select
    LastRow1 = FindLastRow(Sheets("Base").Cells)
    LastCol1 = FindLastcolumn(Sheets("Base").Cells)
    t = ConvertToLetter(LastCol1)
    
    For h = 4 To LastRow
        For i = 4 To LastRow1
            If Sheets("Overview").Range("A" & h) = Sheets("Base").Range("A" & i) Then
               Sheets("Base").Range(t & i) = Sheets("Overview").Range(S & h)
            End If
        Next i
    Next h
    
    srt_Base_Index
    
    Sheets("Medication").Select
    LastRow2 = FindLastRow(Sheets("Medication").Cells)
    LastCol2 = FindLastcolumn(Sheets("Medication").Cells)
    u = ConvertToLetter(LastCol2)
    
    For h = 4 To LastRow
        For i = 4 To LastRow2
            If Sheets("Overview").Range("A" & h) = Sheets("Medication").Range("A" & i) Then
               Sheets("Medication").Range(u & i) = Sheets("Overview").Range(S & h)
            End If
        Next i
    Next h
    
    srt_Medication_Index
    
    Sheets("Overview").Select
    
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    
End Sub

Sub srt_Patient_ID()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Patient ID]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Registry_ID()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Registry ID]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Patient_Initials()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Patient Initials]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Date_Of_Birth()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Date Of Birth]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Sex()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Sex]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Informed_Consent()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Informed Consent]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Center()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Center]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Date_ABPM_Inclusion()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Date ABPM Inclusion]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Base_Completed()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Base Completed]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Medical_History_Completed()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Medical History Completed]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Medication_Completed()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Medication Completed]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Office_BP_Completed()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Office BP Completed]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_ABPM_Completed()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[ABPM Completed]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Laboratory_Results_Completed()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Laboratory Results Completed]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Follow_Up_Completed()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Follow Up Completed]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Overview_Included_in_Registry()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Overview")
    Set tbl = ws.ListObjects("Table1")
    Set sortcolumn = Range("Table1[Included in Registry]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Base_Index()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Base")
    Set tbl = ws.ListObjects("Table2")
    Set sortcolumn = Range("Table2[Index]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
    
End Sub

Sub srt_Medication_Index()
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim sortcolumn As Range

    Set ws = Sheets("Medication")
    Set tbl = ws.ListObjects("Table3")
    Set sortcolumn = Range("Table3[Index]")
    
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With

End Sub
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Is it possible to upload your workbook because the code is not working for me. I was trying to fix it but didn't find the error
 
Upvote 0

Forum statistics

Threads
1,216,518
Messages
6,131,121
Members
449,624
Latest member
MandlaMan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top