jalrs
Active Member
- Joined
- Apr 6, 2022
- Messages
- 300
- Office Version
- 365
- Platform
- Windows
Hello guys,
So on the last weeks I managed to optimize my current code with the help of Kevin9999, Mumps and Joe4. Credits to them. Currently my situation is that the code that I managed to get takes 7 clicks for each department to trigger the last action. My boss thinks this is too much, so I need help optimizing it.
1st action is regarding copying the filtered data and pasting into respective template according to the criteria.
2nd action is to save the template with a specific name, so the file can next follow as attachment with the correct name, avoiding losing the template and having to create a new one from the start.
3rd action is to send the e-mails.
I would like to know if it's possible to complete all actions through a loop, so instead of having 7 clicks for each action for each department, 3 clicks would make it, since I'm pretending to loop.
The dropbox files I'm uploading don't have any lines of code, since I created a brand new bogus information folder to share with whoever may help me.
Next you can find the code for whole process of Apoio SP department, as of now, as an example:
1st action:
2nd action:
3rd action:
Here is the share folder file share
There should be two folders inside main folder called "attachments" and "finaldocname"
I think the "Instructions" Sheet is clear on what I pretend, assuming it is possible.
Macro sheets (1,2,3,4) are there because on the instructions, the source columns to copy are different within each macro as you can see on instruction sheet. All of these are located inside Stock.xlsm
Any additional information regarding the "AS-IS" code just ask.
I hope my "TO-BE" is possible.
Thanks for your attention!
So on the last weeks I managed to optimize my current code with the help of Kevin9999, Mumps and Joe4. Credits to them. Currently my situation is that the code that I managed to get takes 7 clicks for each department to trigger the last action. My boss thinks this is too much, so I need help optimizing it.
1st action is regarding copying the filtered data and pasting into respective template according to the criteria.
2nd action is to save the template with a specific name, so the file can next follow as attachment with the correct name, avoiding losing the template and having to create a new one from the start.
3rd action is to send the e-mails.
I would like to know if it's possible to complete all actions through a loop, so instead of having 7 clicks for each action for each department, 3 clicks would make it, since I'm pretending to loop.
The dropbox files I'm uploading don't have any lines of code, since I created a brand new bogus information folder to share with whoever may help me.
Next you can find the code for whole process of Apoio SP department, as of now, as an example:
1st action:
VBA Code:
Sub filtroApoioSP()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Set wb1 = ThisWorkbook
Set wb2 = Workbooks("T_ApoioSP.xlsm")
Set ws1 = wb1.Worksheets("Stock Trânsito")
Set ws2 = wb2.Worksheets("Pendentes")
ws2.UsedRange.Offset(1).ClearContents
Dim lr1 As Long, lr2 As Long
lr1 = ws1.Cells(Rows.Count, 1).End(3).Row
lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 1
With ws1.Range("A5:AV" & lr1)
.AutoFilter 46, "Apoio SP"
.AutoFilter 47, "Em tratamento"
.Offset(1).Copy ws2.Cells(lr2, 1)
With ws1.Range("BH6:BH" & lr1)
.Copy ws2.Cells(2, 49)
End With
.AutoFilter
End With
lr2 = ws2.Cells.Find("*", , xlFormulas, , 1, 2).Row + 1
ws2.Range("A" & lr2 & ":A1001").EntireRow.Delete
wb2.Activate
ws2.Activate
Dim lr3 As Long
lr3 = Cells(Rows.Count, "AT").End(xlUp).Row
If lr3 > 1 Then
Range("AY2:AY" & lr3).FormulaR1C1 = _
"=IF(RC[-1]="""","""",VLOOKUP(RC[-1],TAB_FDB!C[-50]:C[-49],2,0))"
End If
End Sub2nd action:
VBA Code:
Sub copyPTApoioSP()
Dim path As String
Dim filename As String
path = "C:\Users\joafrodrigue\Desktop\prototipo\Difusao\"
filename = "ST_até31032022_Apoio SP"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs filename:=path & filename & ".xlsx", FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
End Sub3rd action:
VBA Code:
Sub mailptApoioSP()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<BODY style = font-size:12pt; font-familt:Arial>" & _
"Olá equipa, <br><br> Envio este e-mail com os pendentes em questão, até à data, em anexo.<br><br>" & _
"Cumprimentos,<br>João Rodrigues"
On Error Resume Next
With OutMail
.To = Cells(2, 11).Value
.CC = Cells(2, 12).Value
.BCC = Cells(2, 13).Value
.Subject = Cells(2, 14).Value
.Display
.HTMLBody = strbody & .HTMLBody
.Attachments.Add "C:\Users\joafrodrigue\Desktop\prototipo\Difusao\ST_até31032022_Apoio SP.xlsx"
End With
On Error GoTo 0
Set OutMail = Nothing
End SubHere is the share folder file share
There should be two folders inside main folder called "attachments" and "finaldocname"
I think the "Instructions" Sheet is clear on what I pretend, assuming it is possible.
Macro sheets (1,2,3,4) are there because on the instructions, the source columns to copy are different within each macro as you can see on instruction sheet. All of these are located inside Stock.xlsm
Any additional information regarding the "AS-IS" code just ask.
I hope my "TO-BE" is possible.
Thanks for your attention!
Last edited:
