sorting tables

J

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
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
The following code may help you on your way, I just copied your data & placed the dropdown in cell "C1", the functions included are not my code, credit to original provider. The code works by sorting the "Overview" sheet & then adding a temporary sort index based on position & Patient ID, this index is then added to the other two sheets to enable sorting & the index is then cleared from each sheet, you will have to adapt it & repeat sections of code for any additional sheets.

Change Code behind "Overview" sheet

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If ActiveCell.Column = 6 Or ActiveCell.Column = 3 Then
        TestSort
    End If
End Sub

Sub Code in module containing "TestSort"

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) + 1
    s = ConvertToLetter(LastCol)
    
    If Range("C1") = "Patient ID" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Registry ID" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Patient Initials" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("C4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Date Of Birth" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("D4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Sex" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("E4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Informed Consent" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("G4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Center" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("H4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Date ABPM Inclusion" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("I4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Base Completed" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("J4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Medical History Completed" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("K4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Medication Completed" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("L4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Office BP Completed" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("M4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "ABPM Completed" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("N4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Laboratory Results Completed" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("O4"), Order1:=xlAscending, Header:=xlNo
    ElseIf Range("C1") = "Follow Up Completed" Then
       Range("A4:" & s & LastRow).Sort Key1:=Range("P4"), Order1:=xlAscending, Header:=xlNo
    End If

    Range("A4:" & s & LastRow).Sort Key1:=Range("F4"), Order1:=xlDescending, Header:=xlNo
        
    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) + 1
    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
    
    Sheets("Base").Range("A4:" & t & LastRow1).Sort Key1:=Range(t & "4"), Order1:=xlAscending, Header:=xlNo
    
    Sheets("Medication").Select
    LastRow2 = FindLastRow(Sheets("Medication").Cells)
    LastCol2 = FindLastcolumn(Sheets("Medication").Cells) + 1
    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
    
    Sheets("Medication").Range("A4:" & u & LastRow2).Sort Key1:=Range(u & "4"), Order1:=xlAscending, Header:=xlNo
    
    Sheets("Overview").Range(s & ":" & s).ClearContents
    Sheets("Base").Range(t & ":" & t).ClearContents
    Sheets("Medication").Range(u & ":" & u).ClearContents
    Sheets("Overview").Select
    
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    
End Sub

Function Code in another module

VBA Code: 
Function FindLastRow(rg As Range) As Long
    
    On Error GoTo eh
    
    FindLastRow = rg.Find("*", , LookAt:=xlPart, LookIn:=xlFormulas _
            , SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Exit Function
eh:
   If Err.Number = 91 Then
        MsgBox "No data found for range [" & rg.Address & "]. Last row will be set to first row of range."
    End If
    FindLastRow = rg.Cells(1, 1).row
End Function
Function FindLastcolumn(rg As Range) As Long
        
    On Error GoTo eh
    
    FindLastcolumn = rg.Find("*", , LookAt:=xlPart, LookIn:=xlFormulas _
            , SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Exit Function
eh:
   If Err.Number = 91 Then
        MsgBox "No data found for range [" & rg.Address & "]. Last column will be set to first row of range."
    End If
    FindLastcolumn = rg.Cells(1, 1).Column
End Function

Function ConvertToLetter(iCol As Long) As String
   Dim A As Long
   Dim B As Long
   A = iCol
   ConvertToLetter = ""
   Do While iCol > 0
      A = Int((iCol - 1) / 26)
      B = (iCol - 1) Mod 26
      ConvertToLetter = Chr(B + 65) & ConvertToLetter
      iCol = A
   Loop
End Function
 
Upvote 0
Thank you for your reply, but when I tried the code I got run time error 1004 method range of object _global failed. I tried to solve the problem by myself but I couldn't do it.
When I debug the code this line is highlighted: Range("A4:" & s & LastRow).Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlNo (when I try to order the data according to the patient ID) can you please help me to solve the problem?
 
Upvote 0
The error relates to the range, if you put a breakpoint in the 'Sub TestSort' at the line 'If Range("C1") = "Patient ID" Then' & run the code when it stops look in the 'Locals' window in VBA editor & 'LastRow' should equal '10' & 's' should 'Q', if that is correct the sort element should run fine, if that is not the case can you let me know what 'LastRow' & 's' equal. I have attached a screen shot.
TestSort.JPG
 
Upvote 0
Hello,
I have the same values you mentioned but the code is not working
1642586715028.png
 
Upvote 0
Thank you it seems like I have an error somewhere so I will base my work on your excel file and adapt it to what I have.
Thank you again for your help.
 
Upvote 0
I have noticed the problem now, in you excel sheet you didn't group the data into tables. when I grouped them into tables I got the same error.
In my case I need them to be in tables because some fields are filled based on the values in the other table
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Excel VBA drop down populate cells
Replies
4
Views
83
Fluff
Fluff
G
  • Question
Formula to count with multiple criteria and exclude from a separate column, then sort by count in one cell with spill
Replies
0
Views
346
Greenbehindthecells
G
P
  • Question
Dropdown list not working
Replies
0
Views
175
pyclen
P
G
  • Solved
Combobox search dropdown triggering when editing other sheets
2
Replies
10
Views
547
Akuini
Akuini
G
  • Solved
Sort/filter formula used for search formula combobox issue with shorter named values, Formula help for search combobox
Replies
6
Views
533
Akuini
Akuini

Forum statistics

Threads
1,215,001
Messages
6,122,648
Members
449,092
Latest member
peppernaut

Share this page

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