VBA Code AHLTA Last Sign On

Videos:

howTo_filterIntoTabs_1.16.21a  -- 5 stars


Option Explicit
Sub AncillarySvcs()
Dim a As Long
Dim b As Long
Dim i As Long
Dim marks As String
Dim numRows As Long
Dim lastRow As Long
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim lastrow3 As Long
Dim n As Integer

Dim daysSince As Long

Worksheets.Add.Name = "AncillarySvcs"
a = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row

For i = 6 To a
marks = Worksheets("Master").Cells(i, 3).Value
daysSince = Worksheets("Master").Cells(i, 14).Value

If marks = "PHARMACIST" And daysSince >= 21 Or marks = "PHARMACY TECH" And daysSince >= 21 _
Or marks = "PHARMACY TECH,CLINICAL" And daysSince >= 21 Or marks = "FHCC STAFF PHARMACIST" And daysSince >= 21 _
Or marks = "PHARMACY TECHNICIAN" And daysSince >= 21 Or marks = "CLINICAL PHARMACIST" And daysSince >= 21 _
Or marks = "PHARMACIST,CLINICAL" And daysSince >= 21 Or marks = "yyy" And daysSince >= 21 _
Or marks = "AUDIOCARE SYSTEM USER" And daysSince >= 21 Or marks = "PHARMACY RESIDENT" And daysSince >= 21 _
Or marks = "PHARMACY STUDENT" And daysSince >= 21 Or marks = "RADIOLOGY TECH" And daysSince >= 21 _
Or marks = "RAD TECH" And daysSince >= 21 Or marks = "RADIOLOGY TECH - CORPSMAN" And daysSince >= 21 _
Or marks = "RADIOLOGIST TECH" And daysSince >= 21 Or marks = "RADIOLOGIST PROVIDER" And daysSince >= 21 _
Or marks = "AUDIOLOGIST PROVIDER" And daysSince >= 21 Or marks = "PHYSICAL THERAPIST" And daysSince >= 21 _
Or marks = "OPTOMETRIST" And daysSince >= 21 Or marks = "OPTOMETRY TECHNICIAN" And daysSince >= 21 _
Or marks = "DIETICIAN" And daysSince >= 21 Or marks = "LAB TECH - CORPSMAN" And daysSince >= 21 _
Or marks = "LAB TECHNICIAN" And daysSince >= 21 Or marks = "LAB TECH" And daysSince >= 21 _
Or marks = "LAB TECH,FHCC" And daysSince >= 21 Or marks = "LAB MANAGER" And daysSince >= 21 _
Then

Worksheets("Master").Rows(i).Copy
Worksheets("AncillarySvcs").Activate
b = Worksheets("AncillarySvcs").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("AncillarySvcs").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("AncillarySvcs").Range("A1") = "IEN--------"
Worksheets("AncillarySvcs").Range("B1") = "Name----------------------"
Worksheets("AncillarySvcs").Range("C1") = "Title---------------------------------"
Worksheets("AncillarySvcs").Range("D1") = "Fileman access code-------------------"
Worksheets("AncillarySvcs").Range("E1") = "Primary Menu-------------------------"
Worksheets("AncillarySvcs").Range("F1") = "Default Division-----------------------"
Worksheets("AncillarySvcs").Range("G1") = "Primary Clinic Location----------------"
Worksheets("AncillarySvcs").Range("H1") = "Date entered"
Worksheets("AncillarySvcs").Range("I1") = "Last Sign On Date"
Worksheets("AncillarySvcs").Range("J1") = "Date of this audit"
Worksheets("AncillarySvcs").Range("K1") = "Termination Date"
Worksheets("AncillarySvcs").Range("L1") = "AHLTA"
Worksheets("AncillarySvcs").Range("M1") = "Email-----------------------------------"
Worksheets("AncillarySvcs").Range("N1") = "Days since last sign-on-----------------"
Worksheets("AncillarySvcs").Range("A1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("B1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("C1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("D1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("E1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("F1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("G1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("H1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("I1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("J1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("K1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("L1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("M1").Columns.AutoFit
Worksheets("AncillarySvcs").Range("N1").Columns.AutoFit


Range("A2", Range("N2").End(xlDown)).Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlNo


numRows = Application.WorksheetFunction.Subtotal(3, Range("A2:A500000"))

Worksheets("AncillarySvcs").Range("T1") = numRows

End If

Next

Application.CutCopyMode = False
Worksheets("Master").Activate
ThisWorkbook.Worksheets("Master").Cells(1, 1).Select

End Sub
 


Option Explicit
Sub xxx()
Dim a As Long
Dim b As Long
Dim i As Long
Dim marks As String
Dim numRows As Long
Dim lastRow As Long
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim lastrow3 As Long
Dim n As Integer

Dim daysSince As Long

Worksheets.Add.Name = "xxx"
a = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row

For i = 6 To a
marks = Worksheets("Master").Cells(i, 3).Value
daysSince = Worksheets("Master").Cells(i, 14).Value

If marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Or marks = "yyyyy" And daysSince >= 21 Or marks = "yyyyy" And daysSince >= 21 _
Then

Worksheets("Master").Rows(i).Copy
Worksheets("xxx").Activate
b = Worksheets("xxx").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("xxx").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("xxx").Range("A1") = "IEN--------"
Worksheets("xxx").Range("B1") = "Name----------------------"
Worksheets("xxx").Range("C1") = "Title---------------------------------"
Worksheets("xxx").Range("D1") = "Fileman access code-------------------"
Worksheets("xxx").Range("E1") = "Primary Menu-------------------------"
Worksheets("xxx").Range("F1") = "Default Division-----------------------"
Worksheets("xxx").Range("G1") = "Primary Clinic Location----------------"
Worksheets("xxx").Range("H1") = "Date entered"
Worksheets("xxx").Range("I1") = "Last Sign On Date"
Worksheets("xxx").Range("J1") = "Date of this audit"
Worksheets("xxx").Range("K1") = "Termination Date"
Worksheets("xxx").Range("L1") = "AHLTA"
Worksheets("xxx").Range("M1") = "Email-----------------------------------"
Worksheets("xxx").Range("N1") = "Days since last sign-on-----------------"
Worksheets("xxx").Range("A1").Columns.AutoFit
Worksheets("xxx").Range("B1").Columns.AutoFit
Worksheets("xxx").Range("C1").Columns.AutoFit
Worksheets("xxx").Range("D1").Columns.AutoFit
Worksheets("xxx").Range("E1").Columns.AutoFit
Worksheets("xxx").Range("F1").Columns.AutoFit
Worksheets("xxx").Range("G1").Columns.AutoFit
Worksheets("xxx").Range("H1").Columns.AutoFit
Worksheets("xxx").Range("I1").Columns.AutoFit
Worksheets("xxx").Range("J1").Columns.AutoFit
Worksheets("xxx").Range("K1").Columns.AutoFit
Worksheets("xxx").Range("L1").Columns.AutoFit
Worksheets("xxx").Range("M1").Columns.AutoFit
Worksheets("xxx").Range("N1").Columns.AutoFit


Range("A2", Range("N2").End(xlDown)).Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlNo


numRows = Application.WorksheetFunction.Subtotal(3, Range("A2:A500000"))

Worksheets("xxx").Range("T1") = numRows

End If

Next

Application.CutCopyMode = False
Worksheets("Master").Activate
ThisWorkbook.Worksheets("Master").Cells(1, 1).Select

End Sub