Modul1 ----------------------------------------------------------------------------------------------- Option Explicit Public Antibiograms As Collection Public Casuals As Collection Public Cultures As Collection Public Resistances As Collection Public Sub Populate_collections() Set Antibiograms = New Collection Set Casuals = New Collection Set Cultures = New Collection Set Resistances = New Collection Dim a As Antibiogram Dim ca As Casual Dim cu As Culture Dim r As Resistance Dim i As Long Dim sTelomer As String Dim nTelomer As Double sTelomer = "CCCDDD" nTelomer = -123456 Worksheets("Casuals").Activate i = 0 Do While Cells(i + 1, 1).Value <> sTelomer i = i + 1 Set ca = New Casual Casuals.Add ca Call Casuals.Item(Casuals.Count).Set_up(i, i) Loop Worksheets("Antibiograms").Activate i = 1 Do While Cells(i + 1, 1).Value <> nTelomer i = i + 1 Set a = New Antibiogram Antibiograms.Add a Call Antibiograms.Item(Antibiograms.Count).Set_up(i - 1, i) Loop Worksheets("Cultures").Activate i = 1 Do While Cells(i + 1, 1).Value <> nTelomer i = i + 1 Set cu = New Culture Cultures.Add cu Call Cultures.Item(Cultures.Count).Set_up(i - 1, i) Loop Worksheets("Resistances").Activate i = 1 Do While Cells(i + 1, 1).Value <> sTelomer i = i + 1 Set r = New Resistance Resistances.Add r Call Resistances.Item(Resistances.Count).Set_up(i - 1, i) Loop Call Display_collections End Sub Public Sub Display_collections() Dim i As Long Worksheets("CasualsR").Activate For i = 1 To Casuals.Count Call Casuals.Item(i).Display(i) Next i Worksheets("AntibiogramsR").Activate For i = 1 To Antibiograms.Count Call Antibiograms.Item(i).Display(i) Next i Worksheets("CulturesR").Activate For i = 1 To Cultures.Count Call Cultures.Item(i).Display(i) Next i Worksheets("ResistancesR").Activate For i = 1 To Resistances.Count Call Resistances.Item(i).Display(i) Next i End Sub Antibiogram ----------------------------------------------------------------------------------------------- Public ID As Double Public OwnID As Double Public Bacterium_description As String Public Bacterium_abbrevation As String Public SIR_description As String Public SIR_abbrevation As String Public Reagents_abbrevation As String Public Reagent1_description As String Public Reagent2_description As String Public Metric As Double Public Unit As String Public Standard_CLSI As Boolean Public Standard_DIN As Boolean Public Standard_BSAC As Boolean Public Standard_EUCAST As Boolean Public Standard_SFM As Boolean Public Add1 As String Public Add2 As String Public Add3 As String Private Sub Class_Initialize() Me.ID = 0 Me.OwnID = 0 Me.Bacterium_description = "*" Me.Bacterium_abbrevation = "*" Me.SIR_description = "*" Me.SIR_abbrevation = "*" Me.Reagents_abbrevation = "*" Me.Reagent1_description = "*" Me.Reagent2_description = "*" Me.Metric = 0 Me.Unit = "*" Me.Standard_CLSI = False Me.Standard_DIN = False Me.Standard_BSAC = False Me.Standard_EUCAST = False Me.Standard_SFM = False Me.Add1 = "*" Me.Add2 = "*" Me.Add3 = "*" End Sub Public Sub Set_up(ByVal nID As Double, ByVal nRow As Double) Me.ID = nID Me.OwnID = Cells(nRow, 1).Value Me.Bacterium_description = Cells(nRow, 2).Value Me.Bacterium_abbrevation = Cells(nRow, 3).Value Me.SIR_description = Cells(nRow, 4).Value Me.SIR_abbrevation = Cells(nRow, 5).Value Me.Reagents_abbrevation = Cells(nRow, 6).Value Me.Reagent1_description = Cells(nRow, 7).Value Me.Reagent2_description = Cells(nRow, 8).Value Me.Metric = Cells(nRow, 9).Value Me.Unit = Cells(nRow, 10).Value Me.Standard_CLSI = Cells(nRow, 11).Value Me.Standard_DIN = Cells(nRow, 12).Value Me.Standard_BSAC = Cells(nRow, 13).Value Me.Standard_EUCAST = Cells(nRow, 14).Value Me.Standard_SFM = Cells(nRow, 15).Value Me.Add1 = Me.Set_casual() Me.Add2 = Left(Me.Bacterium_description, 5) End Sub Public Function Set_casual() As String Dim i As Long Dim sResult As String sResult = "" For i = 1 To Casuals.Count If Me.Reagent1_description = Casuals.Item(i).Real_description Then sResult = Casuals.Item(i).Mock_description End If Next i Set_casual = sResult End Function Public Sub Display(ByVal nRow As Double) Cells(nRow, 1).Value = Me.ID Cells(nRow, 2).Value = Me.OwnID Cells(nRow, 3).Value = Me.Bacterium_description Cells(nRow, 4).Value = Me.Bacterium_abbrevation Cells(nRow, 5).Value = Me.SIR_description Cells(nRow, 6).Value = Me.SIR_abbrevation Cells(nRow, 7).Value = Me.Reagents_abbrevation Cells(nRow, 8).Value = Me.Reagent1_description Cells(nRow, 9).Value = Me.Reagent2_description Cells(nRow, 10).Value = Me.Metric Cells(nRow, 11).Value = Me.Unit Cells(nRow, 12).Value = Me.Standard_CLSI Cells(nRow, 13).Value = Me.Standard_DIN Cells(nRow, 14).Value = Me.Standard_BSAC Cells(nRow, 15).Value = Me.Standard_EUCAST Cells(nRow, 16).Value = Me.Standard_SFM Cells(nRow, 17).Value = Me.Add1 Cells(nRow, 18).Value = Me.Add2 Cells(nRow, 19).Value = Me.Add3 End Sub Casual ----------------------------------------------------------------------------------------------- Public ID As Double Public Mock_description As String Public Real_description As String Public Add1 As String Public Add2 As String Public Add3 As String Private Sub Class_Initialize() Me.ID = 0 Me.Mock_description = "*" Me.Real_description = "*" Me.Add1 = "*" Me.Add2 = "*" Me.Add3 = "*" End Sub Public Sub Set_up(ByVal nID As Double, ByVal nRow As Double) Me.ID = nID Me.Mock_description = Cells(nRow, 1).Value Me.Real_description = Cells(nRow, 2).Value End Sub Public Sub Display(ByVal nRow As Double) Cells(nRow, 1) = Me.ID Cells(nRow, 2).Value = Me.Mock_description Cells(nRow, 3).Value = Me.Real_description Cells(nRow, 4).Value = Me.Add1 Cells(nRow, 5).Value = Me.Add2 Cells(nRow, 6).Value = Me.Add3 End Sub Culture ----------------------------------------------------------------------------------------------- Public ID As Double Public OwnID As Double Public Internal_code As String Public LID As String Public Culture_class As String Public Participant As String Public Secured_date As Date Public Answered_date As Date Public Catheter_urine As Boolean Public Positive As Boolean Public Molecular As String Public Add1 As String Public Add2 As String Public Add3 As String Private Sub Class_Initialize() Me.ID = 0 Me.OwnID = 0 Me.Internal_code = "*" Me.LID = "*" Me.Culture_class = "*" Me.Participant = "*" Me.Secured_date = #1/1/1970# Me.Answered_date = #1/1/1970# Me.Catheter_urine = False Me.Positive = False Me.Molecular = "*" Me.Add1 = "*" Me.Add2 = "*" Me.Add3 = "*" End Sub Public Sub Set_up(ByVal nID As Double, ByVal nRow As Double) Me.ID = nID Me.OwnID = Cells(nRow, 1).Value Me.Internal_code = Cells(nRow, 2).Value Me.LID = Cells(nRow, 3).Value Me.Culture_class = Cells(nRow, 4).Value Me.Participant = Cells(nRow, 5).Value Me.Secured_date = Cells(nRow, 6).Value Me.Answered_date = Cells(nRow, 7).Value Me.Catheter_urine = Cells(nRow, 8).Value Me.Positive = Cells(nRow, 9).Value Me.Molecular = Cells(nRow, 10).Value Me.Add1 = Left(Me.Culture_class, 5) End Sub Public Sub Display(ByVal nRow As Double) Cells(nRow, 1).Value = Me.ID Cells(nRow, 2).Value = Me.OwnID Cells(nRow, 3).Value = Me.Internal_code Cells(nRow, 4).Value = Me.LID Cells(nRow, 5).Value = Me.Culture_class Cells(nRow, 6).Value = Me.Participant Cells(nRow, 7).Value = Me.Secured_date Cells(nRow, 8).Value = Me.Answered_date Cells(nRow, 9).Value = Me.Catheter_urine Cells(nRow, 10).Value = Me.Positive Cells(nRow, 11).Value = Me.Molecular Cells(nRow, 12).Value = Me.Add1 Cells(nRow, 13).Value = Me.Add2 Cells(nRow, 14).Value = Me.Add3 End Sub Resistance ----------------------------------------------------------------------------------------------- Public ID As Double Public Sex As String Public Age As Double Public Secured_date As Date Public Bacterium As String Public LID As String Public Casual As String Public SIR As String Public Add1 As String Public Add2 As String Public Add3 As String Private Sub Class_Initialize() Me.ID = 0 Me.Sex = "*" Me.Age = 0 Me.Secured_date = #1/1/1970# Me.Bacterium = "*" Me.LID = "*" Me.Casual = "*" Me.SIR = "*" Me.Add1 = "*" Me.Add2 = "*" Me.Add3 = "*" End Sub Public Sub Set_up(ByVal nID As Double, ByVal nRow As Double) Me.ID = nID Me.Sex = Cells(nRow, 1).Value Me.Age = Cells(nRow, 2).Value Me.Secured_date = Cells(nRow, 3).Value Me.Bacterium = Cells(nRow, 4).Value Me.LID = Cells(nRow, 5).Value Me.Casual = Cells(nRow, 6).Value Me.SIR = Cells(nRow, 7).Value Me.Add1 = Left(Me.Bacterium, 5) Me.Add2 = Find_culture() Me.Add3 = Find_antibiogram() End Sub Public Function Find_culture() Dim i As Long Dim nResult As Double nResult = 0 For i = 1 To Cultures.Count If Me.Add1 = Cultures.Item(i).Add1 And Me.LID = Cultures.Item(i).LID Then nResult = Cultures.Item(i).ID End If Next i Find_culture = nResult End Function Public Function Find_antibiogram() Dim i As Long Dim nResult As Double nResult = 0 For i = 1 To Antibiograms.Count If Me.Add1 = Antibiograms.Item(i).Add2 And Me.Casual = Antibiograms.Item(i).Add1 And Me.SIR = Antibiograms.Item(i).SIR_abbrevation Then nResult = Antibiograms.Item(i).OwnID End If Next i Find_antibiogram = nResult End Function Public Sub Display(ByVal nRow As Double) Cells(nRow, 1).Value = Me.ID Cells(nRow, 2).Value = Me.Sex Cells(nRow, 3).Value = Me.Age Cells(nRow, 4).Value = Me.Secured_date Cells(nRow, 5).Value = Me.Bacterium Cells(nRow, 6).Value = Me.LID Cells(nRow, 7).Value = Me.Casual Cells(nRow, 8).Value = Me.SIR Cells(nRow, 9).Value = Me.Add1 Cells(nRow, 10).Value = Me.Add2 Cells(nRow, 11).Value = Me.Add3 End Sub