macro to copy filtered records over to new workbook

[KristelNulens]

Please help me correct the below code. The code is doing what I want it to do up and including line 119.

After line 119 I want to add code to do the following:

Write script, in Microsoft Visual Basic for Applications, to do the following:

1. Create an Excel filed called ‘ETC231_Metrics_ddmmmyyyy’, where ‘ddmmmyyyy’ is the current date, and save the file in the location ‘C:\Users\K.Nulens\OneDrive - Medpace\Documents\STUDIES\_ETC231_ETC-1002-041\METRICS’.
2. Add a Worksheet to the ‘ETC231_Metrics_ddmmmyyyy’ workbook with name ‘Visits missing in EDC’.
3. Copy all records, from the file with name ‘ETC231_Patient_Visits’, located in the location ‘C:\Users\K.Nulens\OneDrive - Medpace\Documents\STUDIES\_ETC231_ETC-1002-041\METRICS’, for which:
4. value of column with column header ‘Visit Name’ (column D) is in (‘S1 Screening’, ‘T1 Day 1 (V1)’, ‘T2 Day 2 (V2)’, ‘T3 Day 15 (V3)’, ‘T4 Day 29 (V4)’, ‘T5 Day 57 (V5)’, ‘T6 Day 58 (V6)’, ‘T7 Day 71 (V7)’, ‘T8 Day 85 (V8)’, ‘T9 Day 113 (V9)’, ‘FU’) and
5. value of column with column header ‘Actual’ is not NULL and
6. value of column with column header ‘in EDC?’ is ‘#N/A’.

Code:

Sub Metrics_CTEDC()
Dim wbDOV As Workbook
Dim wsDOV As Worksheet
Dim lastRowDOV As Long
Dim subjectKeyRangeDOV As Range
Dim visDtRangeDOV As Range
Dim concatenationRangeDOV As Range

Dim wbPatientVisits As Workbook
Dim wsPatientVisits As Worksheet
Dim lastRowPatientVisits As Long
Dim subjectKeyRangePatientVisits As Range
Dim visDtRangePatientVisits As Range
Dim concatenationRangePatientVisits As Range

Dim cell As Range
Dim visitDt As String
Dim i As Long


' Set the workbook and worksheet references for the ETC231_DOV file
Set wbDOV = Workbooks.Open("C:\Users\K.Nulens\OneDrive - Medpace\Documents\STUDIES\_ETC231_ETC-1002-041\METRICS\ETC231_DOV.xlsx")
Set wsDOV = wbDOV.Sheets("DOV")

' Find the last row in column A (SUBJECTKEY column)
lastRowDOV = wsDOV.Cells(wsDOV.Rows.Count, "A").End(xlUp).Row

' Set the range of the SUBJECTKEY column
Set subjectKeyRangeDOV = wsDOV.Range("A2:A" & lastRowDOV) ' Assuming data starts from row 2

' Loop through each cell in the SUBJECTKEY column
For Each cell In subjectKeyRangeDOV
' Check if the cell value is in the format "xxx, yyy"
If InStr(cell.value, ",") > 0 Then
' Replace the comma with a hyphen
cell.value = Replace(cell.value, ", ", "-")
End If
Next cell

' Set the range of the VISDT column
Set visDtRangeDOV = wsDOV.Range("N2:N" & lastRowDOV) ' Assuming data starts from row 2

' Add a new column after the 'last column with data'
wsDOV.Cells(1, wsDOV.UsedRange.Columns.Count + 1).value = "Concatenation_DOV"

' Set the range of the Concatenation_DOV column
Set concatenationRangeDOV = wsDOV.Range("S2:S" & lastRowDOV) ' Assuming data starts from row 2

' Loop through each cell in the Concatenation_DOV column
For Each cell In concatenationRangeDOV
' Concatenate the values of SUBJECTKEY and VISDT
visitDt = wsDOV.Cells(cell.Row, "N").value
cell.value = wsDOV.Cells(cell.Row, "A").value & "-" & Format(DateSerial(Right(visitDt, 4), Left(visitDt, 2), Mid(visitDt, 4, 2)), "dd-mmm-yyyy")
Next cell

With wsDOV.Sort
.SortFields.Clear
.SortFields.Add Key:=wsDOV.Range("S2:S" & lastRowDOV), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange wsDOV.Range("A1:S" & lastRowDOV) ' Data goes up to column S in the spreadsheet
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With



' Set the workbook and worksheet references for the ETC231_Patient_Visits file
Set wbPatientVisits = Workbooks.Open("C:\Users\K.Nulens\OneDrive - Medpace\Documents\STUDIES\_ETC231_ETC-1002-041\METRICS\ETC231_Patient_Visits.xlsx")
Set wsPatientVisits = wbPatientVisits.Sheets("Sheet")

' Find the last row in column A (Site column)
lastRowPatientVisits = wsPatientVisits.Cells(wsPatientVisits.Rows.Count, "A").End(xlUp).Row

' Set the range of the Patients column
Set subjectKeyRangePatientVisits = wsPatientVisits.Range("B2:B" & lastRowPatientVisits) ' Assuming data starts from row 2


' Set the range of the Actual column
Set visDtRangePatientVisits = wsPatientVisits.Range("F2:F" & lastRowPatientVisits) ' Assuming data starts from row 2

' Add a new column after the 'last column with data'
wsPatientVisits.Cells(1, wsPatientVisits.UsedRange.Columns.Count + 1).value = "Concatenation_PatientVisits"

' Set the range of the Concatenation_PatientVisits column
Set concatenationRangePatientVisits = wsPatientVisits.Range("H2:H" & lastRowPatientVisits) ' Assuming data starts from row 2

For i = 2 To lastRowPatientVisits
If Not IsEmpty(visDtRangePatientVisits.Cells(i - 1).value) Then
' Concatenate the values of Patients and Actual
concatenationRangePatientVisits.Cells(i - 1).value = subjectKeyRangePatientVisits.Cells(i - 1).value & "-" & Format(CDate(visDtRangePatientVisits.Cells(i - 1).value), "dd-mmm-yyyy")
End If
Next i

' Add a new column after the 'last column with data'
wsPatientVisits.Cells(1, wsPatientVisits.UsedRange.Columns.Count + 1).value = "In EDC?"
Dim inEDC As Range
Set inEDC = wsPatientVisits.Range("I2:I" & lastRowPatientVisits)


' Sort the data in preparation for the Vlookup
With wsPatientVisits.Sort
.SortFields.Clear
.SortFields.Add Key:=wsPatientVisits.Range("H2:H" & lastRowPatientVisits), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange wsPatientVisits.Range("A1:I" & lastRowPatientVisits) ' Data goes up to column H in the spreadsheet
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Populate 'In EDC?' column using Vlookup
inEDC.Select
Application.CutCopyMode = False
ActiveCell.Formula2R1C1 = "=VLOOKUP(@C[-1],[ETC231_DOV.xlsx]DOV!C19,1,FALSE)"
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I" & lastRowPatientVisits), Type:=xlFillDefault

' Set the location and file name
Dim metricsFilePath As String
Dim metricsFileName As String

metricsFilePath = "C:\Users\K.Nulens\OneDrive - Medpace\Documents\STUDIES\_ETC231_ETC-1002-041\METRICS\"
metricsFileName = "ETC231_Metrics_" & Format(Date, "ddmmmyyyy") & ".xlsx"

' Create Excel application object
Dim excelApp As Object
Set excelApp = CreateObject("Excel.Application")

' Create a new workbook
Dim metricsWorkbook As Object
Set metricsWorkbook = excelApp.Workbooks.Add

' Save the workbook
metricsWorkbook.SaveAs Filename:=metricsFilePath & metricsFileName

' Add a worksheet to the workbook
Dim missingVisitsWorksheet As Object
Set missingVisitsWorksheet = metricsWorkbook.Worksheets.Add
missingVisitsWorksheet.Name = "Visits missing in EDC"

' Set the visit names to filter
Dim visitNames As Variant
visitNames = Array("S1 Screening", "T1 Day 1 (V1)", "T2 Day 2 (V2)", "T3 Day 15 (V3)", "T4 Day 29 (V4)", "T5 Day 57 (V5)", "T6 Day 58 (V6)", "T7 Day 71 (V7)", "T8 Day 85 (V8)", "T9 Day 113 (V9)", "FU")

' Set the columns to copy
Dim columnsToCopy As String
columnsToCopy = "A:H" ' Assuming columns A to H contain the relevant data

' Get the already opened visits workbook
Dim visitsWorkbook As Object
Set visitsWorkbook = Application.Workbooks("ETC231_Patient_Visits.xlsx") ' Replace with the actual visits workbook name

Dim visitsWorksheet As Object
Set visitsWorksheet = visitsWorkbook.Worksheets("Sheet") ' Assuming the visits data is in the first worksheet


' Get the last row number of the visits file
Dim lastRow As Long
lastRow = visitsWorksheet.Cells(visitsWorksheet.Rows.Count, "D").End(-4162).Row ' xlUp = -4162


' Copy the records that meet the criteria to the missing visits worksheet
visitsWorksheet.Activate ' Activate the visits worksheet to apply the filter
visitsWorksheet.Range(columnsToCopy & "1:" & columnsToCopy & lastRow).AutoFilter Field:=4, Criteria1:=visitNames, Operator:=7 ' 7 = xlFilterValues

' Copy the visible cells (filtered data) to the missing visits worksheet
visitsWorksheet.Range(columnsToCopy & "1:" & columnsToCopy & lastRow).SpecialCells(12).Copy Destination:=missingVisitsWorksheet.Range("A1") ' 12 = xlCellTypeVisible

' Turn off the AutoFilter
visitsWorksheet.AutoFilterMode = False

' Save the workbooks
wbDOV.Save
wbPatientVisits.Save
metricsWorkbook.Save

' Release object references
Set cell = Nothing
Set concatenationRangeDOV = Nothing
Set visDtRangeDOV = Nothing
Set subjectKeyRangeDOV = Nothing
Set wsDOV = Nothing
Set wbDOV = Nothing

Set concatenationRangePatientVisits = Nothing
Set visDtRangePatientVisits = Nothing
Set subjectKeyRangePatientVisits = Nothing
Set wsPatientVisits = Nothing
Set wbPatientVisits = Nothing

Set inEDC = Nothing

Set visitsWorksheet = Nothing
Set visitsWorkbook = Nothing
Set visitNames = Nothing
Set missingVisitsWorksheet = Nothing
Set metricsWorkbook = Nothing
Set excelApp = Nothing


End Sub

[#2]

@KristelNulens 

re:

1. value of column with column header ‘Visit Name’ (column D) is in (‘S1 Screening’, ‘T1 Day 1 (V1)’, ‘T2 Day 2 (V2)’, ‘T3 Day 15 (V3)’, ‘T4 Day 29 (V4)’, ‘T5 Day 57 (V5)’, ‘T6 Day 58 (V6)’, ‘T7 Day 71 (V7)’, ‘T8 Day 85 (V8)’, ‘T9 Day 113 (V9)’, ‘FU’) and

if play with sql,looks easier to handle this kind of filter.

e.g.

select * from Sheet where `Visit Name` in ('S1 Screening', 'T1 Day 1 (V1)', 'T2 Day 2 (V2)', 'T3 Day 15 (V3)', 'T4 Day 29 (V4)', 'T5 Day 57 (V5)', 'T6 Day 58 (V6)', 'T7 Day 71 (V7)', 'T8 Day 85 (V8)', 'T9 Day 113 (V9)', 'FU') and Actual!='' and `In EDC` like '#N/A';