CecileRecog
New Member
- Joined
- Jun 24, 2015
- Messages
- 6
Hello everyone
after spending quite some time on this forum and finding quite a lot of useful answers, I am coming to you with my problem.
My company (a private clinic) is in need to get some important data on a daily basis. From the software that we use to manage patients, I can run a report that will give me information in the following columns:
<tbody>
</tbody>
I need to rearrange these to get the important data. On a separate spreadsheet, I have correspondence for all possible appointment type with appointment category and for all possible consulting rooms with "site" (as we operate in more than 1 place). I am very sorry because the code is fairly long and complicated.
My issue is that it takes excel about 45mn to run the whole thing. I have more than 10 000 rows (the report displays all appointments that ever happened), which explains the long time, but 45mn
It takes 100% of the memory when running (I can't do anything else on the computer during that time) and excel keeps going on and off (not responding).
Although I understand that going through more than 10 000 rows of data is a lot to ask excel, any help to make this a bit better would be appreciated.
Here is the code (hoping I am inserting it correctly) I am happy to send the spreasheet if needed.
Thanks a lot for your help!!!
after spending quite some time on this forum and finding quite a lot of useful answers, I am coming to you with my problem.
My company (a private clinic) is in need to get some important data on a daily basis. From the software that we use to manage patients, I can run a report that will give me information in the following columns:
| Patient | Patient ID | Appointment Date | Appointment Type | Clinician | Appointment charge | Invoice Number | Consulting Room | Appointment End Date/Time |
<tbody>
</tbody>
I need to rearrange these to get the important data. On a separate spreadsheet, I have correspondence for all possible appointment type with appointment category and for all possible consulting rooms with "site" (as we operate in more than 1 place). I am very sorry because the code is fairly long and complicated.
My issue is that it takes excel about 45mn to run the whole thing. I have more than 10 000 rows (the report displays all appointments that ever happened), which explains the long time, but 45mn
It takes 100% of the memory when running (I can't do anything else on the computer during that time) and excel keeps going on and off (not responding).
Although I understand that going through more than 10 000 rows of data is a lot to ask excel, any help to make this a bit better would be appreciated.
Here is the code (hoping I am inserting it correctly
) I am happy to send the spreasheet if needed.
Code:
Sub DailyUpdate()'
'
'
Columns("A:A").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").Select
Selection.ColumnWidth = 53.43
Columns("E:E").EntireColumn.AutoFit
'resize columns
Range("A7").Select
ActiveSheet.Name = "GeneralData"
'change name of the sheet in GeneralData
Range("B6").Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B6").Select
ActiveCell.FormulaR1C1 = "New Blood"
' create new column called New Blood
Range("B7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",IF(COUNTIF(R1C1:RC[-1],RC[-1])>1,""OLD"",""NEW""))"
'fill cell following this rule: look in the previous column (Patient name) from beginning until same number cell (RC[-1]) if you can find the name more than once leave the cell empty if not put the name
Range("B7").Select
Range("B7:B" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy the formula until last active cell seen in A
Columns("B:B").EntireColumn.AutoFit
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("F6").Select
ActiveCell.FormulaR1C1 = "Appointment Category"
'create new column call Appointment Category
Range("F7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",LOOKUP(RC[-1],'\\RECOGPC05\Patient Details\Software\
[listdonotdelete.xlsx]Sheet1'!C21,'\\RECOGPC05\Patient Details\Software\
[listdonotdelete.xlsx]Sheet1'!C22))"
'in cell F7, formula: if the cell in column F is empty, cell G stays empty, if not look for the content in column U of ListDONOTDELETE and fill with corresponding content from column V
Range("F7").Select
Range("F7:F" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
Columns("F:F").EntireColumn.AutoFit
'copy the formula until last active cell seen in A and autofit
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H6").Select
ActiveCell.FormulaR1C1 = "NEW EVENT Help1"
'insertion column NEW EVENT Help1
Range("H7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-7]&""-""&RC[-1])"
'formula: combined Patient(RC[-7])-Clinician(RC[-1]) except if Clinician empty, leave empty
Range("H7").Select
Range("H7:H" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy formula until last active cell seen in A
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I6").Select
ActiveCell.FormulaR1C1 = "NEW EVENT Help2"
'insertion column NEW EVENT Help2
Range("I7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",IF(COUNTIF(R1C8:RC[-1],RC[-1])>1,""FU"",""NEW""))"
'formula:if the cell in column H is empty, leave empty, if not look at column H from beginning until same line, if the result appears more than once FU, if not NEW
Range("I7").Select
Range("I7:I" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy formula until last active cell seen in A
Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J6").Select
ActiveCell.FormulaR1C1 = "NEW EVENT Help3"
'insertion column NEW EVENT Help3
Range("J7").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(RC[-4]=""Clinical Trials"",RC[-4]=""Clinical Trials Screening""),RC[-4],RC[-1])"
'formula:if the cell in column F says Clinical Trials or Clinical Trials Screning, copy this cell otherwise cell in column I
Range("J7").Select
Range("J7:J" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy formula until last active cell seen in A
Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("K6").Select
ActiveCell.FormulaR1C1 = "NEW EVENT"
'insertion column NEW EVENT
Range("K7").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(RC[-5]=""Pathology"",RC[-5]=""Imaging""),""Investigation"",RC[-1])"
'formula: if cell on same line in column F (RC[-5]) says Pathology or Imaging, fill cell with Investigation, if not copy cell column I (RC[-1])
Range("K7").Select
Range("K7:K" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy formula until last active cell seen in A
Columns("H:J").Select
Range("H4").Activate
Selection.EntireColumn.Hidden = True
'hide columns helper columns
Columns("O:O").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("O6").Select
ActiveCell.FormulaR1C1 = "SITE"
'insertion column SITE
Range("O7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",LOOKUP(RC[-1],'\\RECOGPC05\Patient Details\Software\
[listdonotdelete.xlsx]Sheet1'!C24,'\\RECOGPC05\Patient Details\Software\
[listdonotdelete.xlsx]Sheet1'!C25))"
'formula: if cell in column M same line (RC[-1]) is empty, leave empty, if not search cell in column M same line (RC[-1]) in column X in ListDONOTDELETE sheet (C24) and return corresponding cell in column Y (C25)
Range("O7").Select
Range("O7:O" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy formula until last active cell seen in A
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "NewBloodLondon"
'add sheet NewBloodLondon
Sheets("GeneralData").Select
Columns("D:D").Select
Selection.NumberFormat = "m/d/yyyy"
'change format date column to get rid of time
Range("A:A,B:B,D:D,F:F,L:L,O:O").Select
Range("O1").Activate
Selection.Copy
Sheets("NewBloodLondon").Select
ActiveSheet.Paste
Range("B7").Select
'copy paste relevant columns on sheet NewBloodLondon
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D6").Select
ActiveCell.FormulaR1C1 = "Date help1"
'insert column Date help1
Range("D7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",IF(MONTH(RC[-1])<4,""Q1"",IF(MONTH(RC[-1])>9,""Q4"",IF(AND(MONTH(RC[-1])>3,MONTH(RC[-1])<7),""Q2"",""Q3""))))"
'formula: determine quarter, leave empty if date empty
Range("D7").Select
Range("D7:D" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy formula until last active cell seen in A
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E6").Select
ActiveCell.FormulaR1C1 = "Date help2"
'insert column Date help2
Range("E7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",YEAR(RC[-2]))"
Range("E7").Select
Range("E7:E" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
Columns("E:E").Select
Selection.NumberFormat = "General"
'formula to get year then copy formula until last active cell seen in A
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("F6").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "Date"
'insert column Date
Range("F7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",RC[-2]&""-""&RC[-1])"
Range("F7").Select
'combine columns Date help1 and Date help2
Range("F7:F" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy formula until last active cell seen in A
Columns("D:E").Select
Range("D4").Activate
Selection.EntireColumn.Hidden = True
'hide columns Date help1 and Date help2
Columns("F:F").Select
Selection.Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("K:K").RemoveDuplicates Columns:=1, Header:= _
xlNo
Range("K1").Select
Selection.Delete Shift:=xlUp
'copy date and remove duplicates
Columns("G:G").Select
Selection.Copy
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("L:L").Select
Application.CutCopyMode = False
ActiveSheet.Range("L:L").RemoveDuplicates Columns:=1, Header:= _
xlNo
ActiveWorkbook.Worksheets("NewBloodLondon").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("NewBloodLondon").Sort.SortFields.Add Key:=Range("L1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("NewBloodLondon").Sort
.SetRange Range("L:L")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("L1:L2").Select
Range("L2").Activate
Selection.Delete Shift:=xlUp
Range("L1:L200").Select
Selection.Copy
Range("M1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'copy category, remove duplicates and sort by alphabetical order and copy/paste with transcription (to get column in line)
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
'suppress column L
Dim i As Long, MaxColumns As Long
Dim WrongHeaderName As String
MaxColumns = ActiveSheet.UsedRange.Columns.Count
WrongHeaderName = "Clinical Trials"
WrongHeaderName2 = "Clinical Trials Screening"
For i = MaxColumns To 1 Step -1
If ActiveSheet.Cells(1, i).Value = WrongHeaderName Then ActiveSheet.Cells(1, i).EntireColumn.Delete xlshiftleft
Next i
'suppress column Clinical Trials
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C6=RC11)*(C7=R1C)*(C9=""London"")*(C2=""NEW""))"
'formula: sum of all NEW in column G (C7) that meet the criteria 1/column F (C6)=cell same line in column K(RC11) 2/column G (C7)=cell same column line 1 (R1C) and 3/ column I (C9)= London
Range("L2").Select
Dim LastCol As Long, LastRow As Long
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "K").End(xlUp).Row
Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
'copy formula in all table
Sheets("NewBloodLondon").Select
Sheets("NewBloodLondon").Copy After:=Sheets(2)
Sheets("NewBloodLondon (2)").Select
Sheets("NewBloodLondon (2)").Name = "NewBloodHH"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C6=RC11)*(C7=R1C)*(C9=""Holly House"")*(C2=""NEW""))"
Range("L2").Select
Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
Range("L19").Select
'same method to create sheet HH
Sheets("NewBloodHH").Select
Application.CutCopyMode = False
Sheets("NewBloodHH").Copy After:=Sheets(3)
Sheets("NewBloodHH (2)").Select
Sheets("NewBloodHH (2)").Name = "NewBloodGuildford"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C6=RC11)*(C7=R1C)*(C9=""Guildford"")*(C2=""NEW""))"
Range("L2").Select
Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
'same method to create sheet Guildford
'if Windsor relevant remove the ' in the following paragraph (except this line)
'Sheets("NewBloodGuildford").Copy After:=Sheets(3)
'Sheets("NewBloodGuildford (2)").Select
'Sheets("NewBloodGuildford (2)").Name = "NewBloodWindsor"
'Range("L2").Select
'ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C6=RC11)*(C7=R1C)*(C9=""Windsor"")*(C2=""NEW""))"
'Range("L2").Select
'Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "NewEventLondon"
'create sheet NewEventLondon
Sheets("GeneralData").Select
Range("A:A,D:D,F:F,K:K,L:L,O:O").Select
Range("O1").Activate
Selection.Copy
Sheets("NewEventLondon").Select
ActiveSheet.Paste
Range("F7").Select
'copy paste relevant columns
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C6").Select
ActiveCell.FormulaR1C1 = "Date help1"
'insert column Date help1
Range("C7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",IF(MONTH(RC[-1])<4,""Q1"",IF(MONTH(RC[-1])>9,""Q4"",IF(AND(MONTH(RC[-1])>3,MONTH(RC[-1])<7),""Q2"",""Q3""))))"
'formula: determine quarter, leave empty if date empty
Range("C7").Select
Range("C7:C" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy formula until last active cell seen in A
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D6").Select
ActiveCell.FormulaR1C1 = "Date help2"
'insert column Date help2
Range("D7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",YEAR(RC[-2]))"
Range("D7").Select
Range("D7:D" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
Columns("D:D").Select
Selection.NumberFormat = "General"
'formula to get year then copy formula until last active cell seen in A
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E6").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "Date"
'insert column Date
Range("E7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",RC[-2]&""-""&RC[-1])"
Range("E7").Select
'combine columns Date help1 and Date help2
Range("E7:E" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
'copy formula until last active cell seen in A
Columns("C:D").Select
Range("C4").Activate
Selection.EntireColumn.Hidden = True
'hide columns Date help1 and Date help2
Columns("E:E").Select
Selection.Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("K:K").RemoveDuplicates Columns:=1, Header:= _
xlNo
Range("K1").Select
Selection.Delete Shift:=xlUp
'copy date and remove duplicates
Columns("F:F").Select
Selection.Copy
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("L:L").Select
Application.CutCopyMode = False
ActiveSheet.Range("L:L").RemoveDuplicates Columns:=1, Header:= _
xlNo
ActiveWorkbook.Worksheets("NewEventLondon").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("NewEventLondon").Sort.SortFields.Add Key:=Range("L1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("NewEventLondon").Sort
.SetRange Range("L:L")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("L1:L2").Select
Range("L2").Activate
Selection.Delete Shift:=xlUp
Range("L1:L200").Select
Selection.Copy
Range("M1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'copy category, remove duplicates and sort by alphabetical order and copy/paste with transcription (to get column in line)
For i = MaxColumns To 1 Step -1
If ActiveSheet.Cells(1, i).Value = WrongHeaderName Or ActiveSheet.Cells(1, i).Value = WrongHeaderName2 Then ActiveSheet.Cells(1, i).EntireColumn.Delete xlshiftleft
Next i
'suppress column Clinical Trials and Clinical Trials Screening
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
'suppress column L
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C5=RC11)*(C6=R1C)*(C9=""London"")*(C7=""NEW""))"
'formula: sum of all NEW in column G (C7) that meet the criteria 1/column E (C5)=cell same line in column K(RC11) 2/column F (C6)=cell same column line 1 (R1C)and 3/ column I (C9)= London
Range("L2").Select
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "K").End(xlUp).Row
Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
'copy formula in all table
Sheets("NewEventLondon").Select
Sheets("NewEventLondon").Copy After:=Sheets("NewEventLondon")
Sheets("NewEventLondon (2)").Select
Sheets("NewEventLondon (2)").Name = "FU-InvestigationLondon"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C5=RC11)*(C6=R1C)*(C9=""London"")*OR(C7=""FU"",C7=""Investigation""))"
Range("L2").Select
Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
Range("L19").Select
'same method to create sheet FU-Investigation
Sheets("FU-InvestigationLondon").Select
Sheets("FU-InvestigationLondon").Copy After:=Sheets("FU-InvestigationLondon")
Sheets("FU-InvestigationLondon (2)").Select
Sheets("FU-InvestigationLondon (2)").Name = "FU-InvestigationHH"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C5=RC11)*(C6=R1C)*(C9=""Holly House"")*OR(C7=""FU"",C7=""Investigation""))"
Range("L2").Select
Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
Range("L19").Select
'same method to create sheet FU-InvestigationHH
Sheets("FU-InvestigationHH").Select
Sheets("FU-InvestigationHH").Copy After:=Sheets("FU-InvestigationHH")
Sheets("FU-InvestigationHH (2)").Select
Sheets("FU-InvestigationHH (2)").Name = "FU-InvestigationGuildford"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C5=RC11)*(C6=R1C)*(C9=""Guildford"")*OR(C7=""FU"",C7=""Investigation""))"
Range("L2").Select
Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
Range("L19").Select
'same method to create sheet FU-InvestigationGuildford
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "ClinicalTrialsLondon"
Sheets("ClinicalTrialsLondon").Select
Sheets("ClinicalTrialsLondon").Move After:=Sheets("FU-InvestigationGuildford")
'create new sheet named ClinicalTrialsLondon after sheet FU-InvestigationGuildford
Sheets("NewEventLondon").Select
Columns("A:I").Select
Selection.Copy
Sheets("ClinicalTrialsLondon").Select
ActiveSheet.Paste
'copy column A to I in NewEventLondon and paste in the new sheet
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("K:K").RemoveDuplicates Columns:=1, Header:=xlNo
Range("K1").Select
Selection.Delete Shift:=xlUp
'copy column E in K, remove duplicates and first cell
Range("L1").Select
ActiveCell.FormulaR1C1 = "Screenings"
Range("M1").Select
ActiveCell.FormulaR1C1 = "FU Visits"
'fill L1 with "Screenings" and M1 with "FU Visits"
Columns("F:F").Select
Selection.Replace What:="Clinical Trials Screening", Replacement:= _
"Screenings", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Selection.Find(What:="Clinical Trials", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.Replace What:="Clinical Trials", Replacement:="FU Visits", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
'in column F replace the sentence "Clinical Trials Screening" by "Screenings" and the sentence "Clinical Trials" by "FU Visits"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C5=RC11)*(C6=R1C)*(C9=""London""))"
'formula: sum of all products that meet the criteria 1/column E (C5)=cell same line in column K(RC11) 2/column F (C6)=cell same column line 1 (R1C) and 3/ column I (C9)= London
Range("L2").Select
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "K").End(xlUp).Row
Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
'copy formula in all table
Sheets("ClinicalTrialsLondon").Select
Sheets("ClinicalTrialsLondon").Copy After:=Sheets("ClinicalTrialsLondon")
Sheets("ClinicalTrialsLondon (2)").Select
Sheets("ClinicalTrialsLondon (2)").Name = "ClinicalTrialsGuildford"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((C5=RC11)*(C6=R1C)*(C9=""Guildford""))"
Range("L2").Select
Range("L2", Cells(LastRow, LastCol)).FormulaR1C1 = Range("L2").FormulaR1C1
Range("L19").Select
'same method to create sheet ClinicalTrialsGuildford
Sheets("GeneralData").Select
ActiveWindow.SelectedSheets.Visible = False
'hide tab GeneralData
End SubThanks a lot for your help!!!
