Good morning
this is a try to write a VBA code that defines an array of sheet names and an array of email addresses., then loops through each element in the sheet array, creates a new workbook, copies the specified sheets from the current workbook to the new workbook, updates formula references in the new workbook to remove any external references and replace commas with semicolons, saves the new workbook to a temporary file path, and then creates an email with the specified subject, message, and attachment and sends it to the corresponding email address. All parts work except the part that removes all external references to formulas.
Can you please help me adjust the code i am sending in order to be able to remove all external references in formulas from all sheets and keeps formulas working?
i.e this: =[2023_PROTOTYPE_VALIDATION_VBAcheck.xlsm]AB_ANM!A4
should be: =AB_ANM!A4
but this: =SUM(B3:H3)
should be kept as it is.
plus all formulas are written with ";" as semicolons and this is the correct form that should be kept because this is the version's i use requirements.
The part that's not working is:
It was supposed to totally remove external references inside formulas but it doesn't. Any ideas?
Thanks a lot
VBA Code:
Function regexFind(strInput As String, strPattern As String) As Object Dim regex As New RegExp Dim regexMatch As Object regex.Pattern = strPattern regex.Global = True Set regexMatch = regex.Execute(strInput) If regexMatch.Count > 0 Then Set regexFind = regexMatch.Item(0) Else Set regexFind = Nothing End If End Function Sub SendEmails() Dim regex As New RegExp Dim sheetArrays(1 To 7) As Variant sheetArrays(1) = Array("PAVLIDIS", "HOURS", "CODE_CLC", "ALL", "LIST", "SCHE_CLC", "MASTER_HOURS", "AB_ANM") sheetArrays(2) = Array("PAVLIDIS", "HOURS", "CODE_CLC", "ALL", "LIST", "SCHE_CLC", "MASTER_HOURS", "AB_HSK") sheetArrays(3) = Array("PAVLIDIS", "HOURS", "CODE_CLC", "ALL", "LIST", "SCHE_CLC", "MASTER_HOURS", "AB_KTC") sheetArrays(4) = Array("PAVLIDIS", "HOURS", "CODE_CLC", "ALL", "LIST", "SCHE_CLC", "MASTER_HOURS", "AB_MNT") sheetArrays(5) = Array("PAVLIDIS", "HOURS", "CODE_CLC", "ALL", "LIST", "SCHE_CLC", "MASTER_HOURS", "AB_MSC") sheetArrays(6) = Array("PAVLIDIS", "HOURS", "CODE_CLC", "ALL", "LIST", "SCHE_CLC", "MASTER_HOURS", "AB_RCP") sheetArrays(7) = Array("PAVLIDIS", "HOURS", "CODE_CLC", "ALL", "LIST", "SCHE_CLC", "MASTER_HOURS", "AB_SRV") Dim emailAddresses(1 To 7) As String emailAddresses(1) = "ns@yahoo.gr" emailAddresses(2) = "ns@yahoo.gr" emailAddresses(3) = "ns@yahoo.gr" emailAddresses(4) = "ns@yahoo.gr" emailAddresses(5) = "ns@yahoo.gr" emailAddresses(6) = "ns@yahoo.gr" emailAddresses(7) = "ns@yahoo.gr" Dim i As Integer For i = 1 To 7 Dim wsArray As Variant wsArray = sheetArrays(i) Dim wb As Workbook Set wb = ThisWorkbook Dim tempWB As Workbook Set tempWB = Workbooks.Add(xlWBATWorksheet) Dim j As Integer For j = LBound(wsArray) To UBound(wsArray) wb.Sheets(wsArray(j)).Copy after:=tempWB.Sheets(tempWB.Sheets.Count) Next j Dim tempFilePath As String tempFilePath = Environ$("temp") & "\" & wsArray(UBound(wsArray)) & ".xlsx" Application.DisplayAlerts = False 'turn off prompt for delete sheet1 tempWB.Sheets(1).Delete 'delete sheet1 Application.DisplayAlerts = True 'turn on prompt for other alerts ' Update formula references Dim editableSheet As Worksheet Set editableSheet = tempWB.Sheets(wsArray(UBound(wsArray))) Dim cell As Range Dim regexPattern As String: regexPattern = "\[[^\]]+\]" ' pattern to match external file path For Each cell In editableSheet.UsedRange If InStr(cell.Formula, "[") > 0 Then Dim regexMatches As Object Set regexMatches = regex.Execute(cell.Formula) If Not regexMatches Is Nothing Then Dim formulaWithoutExternalRef As String formulaWithoutExternalRef = cell.Formula For Each regexMatch In regexMatches formulaWithoutExternalRef = Replace(formulaWithoutExternalRef, regexMatch.Value, "") Next regexMatch formulaWithoutExternalRef = Replace(formulaWithoutExternalRef, ",", ";") ' Replace commas with semicolons formulaWithoutExternalRef = Replace(formulaWithoutExternalRef, "[", "") ' Remove opening square brackets formulaWithoutExternalRef = Replace(formulaWithoutExternalRef, "]", "") ' Remove closing square brackets cell.Formula = formulaWithoutExternalRef End If End If Next cell tempWB.SaveAs tempFilePath Dim outlookApp As Object Set outlookApp = CreateObject("Outlook.Application") Dim outlookMail As Object Set outlookMail = outlookApp.CreateItem(0) With outlookMail .To = emailAddresses(i) .subject = "Your subject here" .Body = "Your message here" .Attachments.Add tempFilePath .Send End With tempWB.Close savechanges:=False Kill tempFilePath 'delete the temp file Next i End Sub
this is a try to write a VBA code that defines an array of sheet names and an array of email addresses., then loops through each element in the sheet array, creates a new workbook, copies the specified sheets from the current workbook to the new workbook, updates formula references in the new workbook to remove any external references and replace commas with semicolons, saves the new workbook to a temporary file path, and then creates an email with the specified subject, message, and attachment and sends it to the corresponding email address. All parts work except the part that removes all external references to formulas.
Can you please help me adjust the code i am sending in order to be able to remove all external references in formulas from all sheets and keeps formulas working?
i.e this: =[2023_PROTOTYPE_VALIDATION_VBAcheck.xlsm]AB_ANM!A4
should be: =AB_ANM!A4
but this: =SUM(B3:H3)
should be kept as it is.
plus all formulas are written with ";" as semicolons and this is the correct form that should be kept because this is the version's i use requirements.
The part that's not working is:
VBA Code:
' Update formula references
Dim editableSheet As Worksheet
Set editableSheet = tempWB.Sheets(wsArray(UBound(wsArray)))
Dim cell As Range
Dim regexPattern As String: regexPattern = "\[[^\]]+\]" ' pattern to match external file path
For Each cell In editableSheet.UsedRange
If InStr(cell.Formula, "[") > 0 Then
Dim regexMatches As Object
Set regexMatches = regex.Execute(cell.Formula)
If Not regexMatches Is Nothing Then
Dim formulaWithoutExternalRef As String
formulaWithoutExternalRef = cell.Formula
For Each regexMatch In regexMatches
formulaWithoutExternalRef = Replace(formulaWithoutExternalRef, regexMatch.Value, "")
Next regexMatch
formulaWithoutExternalRef = Replace(formulaWithoutExternalRef, ",", ";") ' Replace commas with semicolons
cell.Formula = formulaWithoutExternalRef
End If
End If
Next cell
Thanks a lot