Create new worksheet - vba

Question

I have a workbook that will contain worksheets with the text “benefits” in the sheet name. For example; MEDICALBenefits or DENTALBenefits. There will always be at least one, but there could be several.
I am trying to write a macro that will find the worksheet(s) with the text “benefits” in the sheet name AND at least one instance of the word TRUE in row 40.
When these two criteria are met then I need to create a new worksheet using the same worksheet name but replacing the text “Benefits” with the text “Final”, In other words; If the worksheet MEDICALBenefits has TRUE in one or more cells in row 40 then a new sheet called MEDICALFinal would be created.
Likewise, if the worksheet DENTALBenefits has TRUE in one or more cells in row 40 then a new sheet called DENTALFinal would be created.
I then need it to loop through all the sheets looking for “Benefits” in the name and TRUE in row 40 and create a new sheet.
This is the code I have so far, but need help with naming the new sheets.
Jordan
'Look for worksheet names *benefits* with checkbox(s) = true
Sub CreateFinalWorksheet()
Dim sh As Worksheet
Dim iVal As Integer
Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Sheets
iVal = Application.WorksheetFunction.CountIf(Range("40:40"), "TRUE")
If (LCase$(sh.Name) Like "*benefits*") And (iVal > 0) Then Call AddWorksheet
Next sh
Application.ScreenUpdating = True
End Sub
'Called from CreateFinalWorksheet.
'Add worksheet with same sheet name replacing *benefits* with *final*
Sub AddWorksheet()
Dim sh As Worksheet
With ThisWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = "MedicalFinal"
End With
End Sub

Answer 1

edited after OPs clarification he wants to find all "*benefits" sheets
in
iVal = Application.WorksheetFunction.CountIf(Range("40:40"), "TRUE")
you're missing current sh worksheet reference, so you want to write as follows:
iVal = Application.WorksheetFunction.CountIf(sh.Range("40:40"), "TRUE")
For what above and for your main issue, I'd go like follows:
Sub CreateFinalWorksheet()
Dim sh As Worksheet
Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Sheets
If (LCase$(sh.Name) Like "*benefits") Then
If WorksheetFunction.CountIf(sh.Rows(40), "TRUE") = 0 Then AddWorksheet sh.Name
End If
Next sh
Application.ScreenUpdating = True
End Sub
Sub AddWorksheet(shtName As String)
Dim sh As Worksheet
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.count)).Name = Replace(LCase$(shtName), "benefits", "Final")
End With
End Sub

Answer 2

Add a parameter to your AddWorksheet routine, let it be the "benefits"worksheet
If (LCase$(sh.Name) Like "*benefits*") And (iVal > 0) Then AddWorksheet sh
Sub AddWorksheet(benef as worksheet)
....
ws.name = Replace(benef.name, "benefits", "Final", , vbTextCompare)
Eventually, you can also do other things inside this sub, such as copying some data from the parameter worksheet benef.