FlaviaTaynara

Ola, preciso de ajud apara entender como trabalhar com dicionarios no VBA Eu tenho 3 abas com planilha que preciso usar 2 dicionarios se interagindo. Aba com nome Start da onde tirarei os dados sheet 1 aba onde preciso procurar o item do dicionario na columna A Final Aba - achar o numero do cliente na linha para popular a coluna com informacao do AbA Sheet 1. Eu estou tentando adicionar 4 columnas no dicionario onde a chave do dicionario sera os valores de uma das columnas. S. Consumer Number = S.Con # /// P. Consumer number = P. Con# 119 = 1000000000000297914 /// 18 = 2000000000078038566 Porque terei de usar o S. Consumer Number /// P. Consumer number para encontrar a o valor igual em outra planilha, e usar o Reason Status localizado na columna H para par adicionar este valor em outr planilha. Na planilha de nome Final, o Status Reason precisa ser adicionado à coluna I se o número do consumidor corresponder ao numero na columna A. Sera que alguém poderia me ajudar, me ensinando ou falando de metodos de conseguir isso? Agradeco desde de ja.

Eu tenho um PivotTable que os dados mudam sempre que a planilha for atualizada (aberta) e eu preciso de um VBA code que calcule quais sao os meses ativos no ultimo semestre para poder tirar um media deles. e.g ex: nesta imagem eu precisaria calcular a media usando apenas 5 meses (2020 Jan, Fev, Mar & 2019 Dez, Out), pois esses sao os meses ativos do cliente. como poderia fazer isso? seria possivel usar a Funcao last quarter = dois meses? como poderia fazer isso? seria possivel usar a Funcao last quarter = dois meses? Public Function LastQuarter(theDate As Date) As Date + 2 months to get the last semester? DateSerial(Year(theDate), 2)+2

Resposta eh: A:A- coluna de data , B:B - coluna de valores =IF(MONTHS(MAX(A:A)-MIN(A:A))>=6;SUMIF(A:A;">="&EDATE(MAX(A:A);-6);B:B)/6;SUMIF(A:A;">="&EDATE(MAX(A:A);-6);B:B)/MONTHS(MAX(A:A)-MIN(A:A)))

Aqui eu resolvi o problema criando uma nova tabela em outra planilha, copiando as columas de data e nomes da planilha de dados e craindo 2 novas colunas usando excel formula =IF(COUNTIF($B$1:B2,B2)=1,A2,0) e =IF(COUNTIF($B$1:B2,B2)=1,B2,"") e em seguida usei a pocao de criar pivot e consegui o resultado que precisava.

Olá, O usuário do Excel exportará os dados de um site online para o Excel (dados de 12 meses), logo os dados serao sempre diferentes. Portanto, a fórmula ou VBA codigo precisaria ser dinâmica. Desejo calcular a média dos últimos 6 meses (no entanto, o cálculo precisa usar os meses que tenho nos dados e, às vezes, haverá menos de 6 ou 12 meses, ou pode ser como: Jun, Aug, Set, Dez, -2019 & Fev, Mar, Abr 2020) mas ainda preciso obter a média para isso. Estou tentando de maneira diferente com esta fórmulas: =IF(MONTH(MAX('12 Months'!A:A)-MIN('12 Months'!A:A))>=6,COUNTIF('12 Months'!A:A,">="&EDATE(MAX('12 Months'!A:A),-6))/6,AVERAGEIF('12 Months'!F:F,">="&MIN('12 Months'!F:F))/MONTH(MAX('12 Months'!F:F)-MIN('12 Months'!F:F))) esta eu simplesmente nao sei, apenas juntei tudo para ver se funcionava... (pois tenho uma formula aprecida para tirar a media da frequencia e funcionou entao pensei que se usasse as duas daria certo. esta e a formula da frequencia que funciona como preciso =IF(MONTH(MAX('12 Months'!A:A)-MIN('12 Months'!A:A))>=6,COUNTIF('12 Months'!A:A,">="&EDATE(MAX('12 Months'!A:A),-6))/6,COUNTIF('12 Months'!A:A,">="&MIN('12 Months'!A:A))/MONTH(MAX('12 Months'!A:A)-MIN('12 M onths'!A:A))) E =AVERAGEIF(('12 Months'!A:A),">="&EDATE(MAX('12 Months'!A:A),-12),('12 Months'!F:F)) ''' esta funciona, porém esta calculando como o ano enteiro e nao somente os meses que eu tenho no meus dadtos.

Olá a todos, preciso de ajuda para criar uma tabela que ira funcionar com outros varios dados, (ja que a cada fez que o usuario baixar os dados, o mesmo dados sera diferente). O usuário do Excel exportará os dados de um site online para o Excel (dados dos ultimos 12 meses). O filtro não funcionará no meu caso, porque os dados que tenho serão alterados o tempo todo (às vezes será varios às vezes haverá apenas alguns nomes). Existe algum código VBA que “automaticamente” crie uma nova tabela que mostre apenas os nomes unicos (quando comparados com os dados dos ultimos 12 meses) e que ao criar a nova tabale o mesmo ira separar os nomes por meses? por exemplo: Maio Able Target Limited Denline Uniforms, inf Electron Microscopy Sciences Junho não ira parecer na tabela ja que neste mes não tera nenhum nome novo Julho DLAB… PS: A columa com os nomes que preciso comparar e criar a uma nova tabela se encontra na coluna N e a data esta na coluna A da abla com nome 12 Months. ou teria alguma outra maneira, seria melhor usar os dados gerados pelo pivot ou direto da tabela de 12 months dados? muito obrigada

@osvaldomp Obrigada. Ja fiz o download da apostila e irei começar a estuda-la hoje mesmo. Gostaria de lhe pedir desculpas, por lhe encher tanto e se lhe ofendi chamandoo de senhor (confesso que meu português está um pouco enferrujado). Mais uma vez muito obrigada por toda ajuda e paciência. Tenha uma otima continuação de semana e Feliz Páscoa adiantado.

@osvaldomp Obrigada. Mas infelizmente ainda nao entendi exatamente como caixa de selecao funciona para copiar e colar informações. Eu usei o mesmo codigo (pois as tabelas sao praticamentes iguais) e troquei as informações sobre as linhas e colunas de origem e de destino, porém nao consegui o resultado desejado. Neste caso o que estou fazendo de errado? Se consegui anexar corretamente o arquivo zipado tem todos os codigos que estou usando ate o momento neste novo woorkbook. O codigo para copiar e passar os dados estão no mudulo Alert_L2 O senhor poderia me recomendar algum website onde eu possa mais sobre esse assunto? (checkBox).rar (lastcheckBox).xlsx

@osvaldomp Muito obrigada, o codigo funcionou perfeitamente. porém eu estoou ainda tentando entender como o codigo funciona, seria atraves dos numeros das celulas e coluna? Por example tenho outra tabela que tambem preciso copiar as informações dela para outra tabela, nesse caso preciso apenas saber o numero certo de cada celula e coluna? 1- consegui deletar todas as caixas de selecao e deixar apenas 1. 2 - obrigada pela dica, nao fazia ideia.

@osvaldomp Netse workbook, eu coloquei o codigo no modulo com o nome Alert_L2. tenho essas duas abas Alert XX.XX.XXXX e Alert *XXX* (Level 2) no meu workbook. O que quero é copiar as informações que esteja disponivel na tabela da aba Alert XX.XX.XXXX (porém apenas se o checkbox estiver selecionado na coluna M (L2)) e passar as informações para a tabela na aba Alert *XXX* (Level 2).

@osvaldomp ola, sera qu epoderia me ajudar novamente com esse codigo? O codigo esta funcionando corretamente, porém agora estou tentando transportar as informações em outra tabale (outro workbook) e as informações estão sendo colada no local errado da Tabela.

Olá, Consigui obter as coordenadas onde preciso inserir as informações para pesquisa. O problema agora é que não sei como reuni-lo dentro do código para que ele funcione. Eu estou supondo que eu preciso: Manipular a janela aberta do chrome "Eu tenho o código que abre o chrome" Eu preciso de um código que possa colocar valor nesse campo de entrada usando a linha com as coordenadas. Talvez alguém possa me ajudar? Document.getElementById("ctl32_ctl04_ctl03_txtValue").Value = searchname1

Boa tarde, Preciso utilizar informações de algumas células do excel para fazer pesquisa em uma página específica, porém o código que tenho está funcionando em partes. O código abre página que preciso para pesquisa, porém as informações que necessito pesquisar nao sao aparecem no local correto ( Document.getElementById("ctl32_ctl04_ctl03_txtValue").Value). Nao sei que tipo de codigo devo usar apos a website desejado estiver aperto para que as informações para pesquisao seja colocadas no local certo. Sub Level2_SSR() Dim chromePath As String Dim temp As Variant Dim searchname1 As String Dim temp2 As Variant Dim temp3 As Variant Dim chrome As Object Set chrome = CreateObject("Selenium.WebDriver") Dim html As HTMLDocument Dim Document As Object Set Document = CreateObject("Selenium.WebDriver") Dim elm As Object Set elm = CreateObject("Selenium.webDriver") Alert1.Activate chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" If Range("H2").Value <> "" Then 'split the sign '&' searchname1 = Range("H2").Value 'Bene1 Name temp2 = Split(searchname1, " "): searchname1 = Join(temp2, "+") 'Client name) 'Bene1 Name temp3 = Split(searchname1, "&"): searchname1 = Join(temp3, "%26") 'Client name 'Bene1 Name Shell (chromePath & " -url http://wubsreporting.chgfe.biz/Reports/Pages/Report.aspx?ItemPath=%2fCompliance+Operations%2fEntity+Name+Search+(Tabular)+Recommended") Set Document.getElementById("ctl32_ctl04_ctl03_txtValue").Value = searchname1 End If End Sub

@osvaldomp aim estava. no final o problema era com o nome do modulo, troquei o nome do modulo e do Sub vinculei novamente o macro ao Botão e salvei o arquivo, fechei e abrir novamente e deu certo. mais uma vez obrigada por ajudar. ps: saberia me dizer como posso marcar como resolvido a minha pergunta aqui no forum?

Ola, Estou tendo problemas para rodar o madro a um botao, o erro The macro may not be available in this workbook or all macros may be disabled. O codigo em si esta funcionando e quando rodo o macro pelos botões F5 ou F8 ele funciona perfeitamente. Eu ja tentei debugging the Macro, mudar o "sub" to "public sub", abrir um novo Modulo colar o codigo la, eu tambem ja mudei o nome do modulo e do subs varias vezes e mesmo assim o erro aparece. Public Sub searchsOnline_benes() Dim chromePath As String Dim temp As Variant Dim searchname1 As String Dim temp2 As Variant Dim temp3 As Variant Alert1.Activate chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" 'split the sign '&' searchname1 = Range("H2").Value 'Bene1 Name temp2 = Split(searchname1, " "): searchname1 = Join(temp2, "+") 'Client name 'Bene1 Name temp3 = Split(searchname1, "&"): searchname1 = Join(temp3, "%26") 'Client name 'Bene1 Name Shell (chromePath & " -url http://irisportal.chgfe.biz/sites/IRIS/TMS/_layouts/OSSSearchResults.aspx?k=" & searchname1) End sub

@osvaldomp varei isso. Muito obrigada pela ajuda e paciência. Bom final de semana

@osvaldomp Bom dia, O codigo funcionou, porém o mesmo salvou em cima do arquivo ja salvo pelo Alert (CCISD 03.27.2020). Eu esqueci de mencionar que o nome do cliente é extraido de um outro programa e por isso tem essa parte no codigo para poder arrumar o nome como os times necessitao. savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") Somos 2 times: Level 1 e Level 2. O level 1 ira usar excel file (que neste momento tem outro nome, um nome generico) para fazer as investigacoes necesarias. Os dados como cliente e beneficiarios sao extraidos de um outro programa e transferido para o template do excel. Apos o time 1 terminar suas anotacoes o mesmo ira usar usar o botao salve file na aba Alert e automaticamente um novo arquivo sere salvo em uma pasta especifica neste caso e ("\Desktop\ Ingestigations\"). O time 2 ira receber o arquivo salvo pelo time 1 e comecara a trabalhar nele e apos terminar tambem ira usar o botao Save File (porém na aba do Level 2) para que o mesmo seja salvo tambem em uma local especificico ("\Desktop\ Ingestigations\"). Eu notei que: se na pasta de destino ("\Desktop\ Ingestigations\") do level 2 nao tiver o arquivo do time 1 salvo, ao apertar o botao save file na aba do level 2 o mesmo ira salver corretamente. porém se na pasta de destino ("\Desktop\ Ingestigations\") do level 2 ja existir o arquivo salvo pelo time 1 o botao ira apenas apenas salvar uma atualizacao do mesmo, salvando em cima do que arquivo que ja existe. Uma das opções que acho que poderia funcionar seria fazer outra pasta de destino para o time do level 2 ex: \Desktop\ Ingestigations Level 2\ ou mudar completamente o codigo do level 2. A unica coisa que o codigo do level 2 precisa fazer antes de salvar como um novo arquivo e novo nome é chegar se o screenshots estão no local correto e corrigir erros de ortografia, enato ira salvar na pasta de destino. ("\Desktop\ Ingestigations\"). ob: O time do level 2 normalmente nao faz nenhuma auteracao na aba do cliente e nem insere nenhum dado de outros programas, logo a data que se encontra na aba Cliente Review sera a data em que o time 1 salvou o arquivo (usando o botao da aba Alert). Obrigada pela paciencia comigo e por toda a ajuda.

Desculpa acabei me empolgando. Neste momento estou revisando o codigo do Salve File da aba Alert XX.XX.XXXX (Level 2) que esta do modulo Level_2 e ja anotei varias partes que pode ser deletada. O que eu preciso é: Que quando o botao Save File da aba Alert XX.XX.XXXX (Level 2) funcione salvando um novo arquivo com mesmo nome apenas acrescentando (Level 2) na frente ex: CCISD 03.26.2020 (o botao save file na aba Alert XX.XX.XXXX criou este arquivo quando foi selecionado). O time do level 2 ira usar este arquivo criado por ele e fazer suas anotacoes na Aba do Level 2 e ira salvar novamente, pore neste momento usando o botao Save File disponivel na Aba Alert XX.XX.XXXX (Level 2) e o novo arquivo tera o nome de ex: CCISD 03.27.2020 (Level 2). preciso fazer como um novo arquivo com o mesmo nome que o anterior so acrescentando (Level 2 a frente) e chegar. Sub Save_Level_2_File() Dim ws As Worksheet Dim Client As ClientReview Alert1.Cells.CheckSpelling ClientReview.Cells.CheckSpelling If Application.ActiveWorkbook.Path = Environ("userprofile") & "\Desktop\Investigations" Then ActiveWorkbook.Save MsgBox " File has been saved successfully." Exit Sub End If Dim today As String Dim savePath As String Dim CompanyName As String Dim UserName As String ClientReview.Activate today = Format(Date, "MM.DD.YYYY") Range("C6").Value = today savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") UserName = Application.UserName Alert1.Visible = xlSheetVisible Alert1.Activate Range("C1").Value = UserName Alert1.Name = "Alert " & today & " (Level 2)" ' button save file Level 2 If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations") End If On Error GoTo ErrorMessage ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & " (Level 2)" & ".xls" MsgBox "File has been successfully saved to investigations folder in user's desktop." Exit Sub ErrorMessage: MsgBox "Something went wrong, file not saved!" End Sub CCISD 03.26.2020.xlsx adicionado 27 minutos depois @osvaldomp Ah esqueci de mencionar que o nome do arquivo é baseado no nome do Client name for search (Na coluna C linha 1) que se encontra na aba Client Review.

@osvaldomp Bom dia, Tens razao, teu codigo esta funcionando perfeitamente. Notei que nao tem relação se a checkbox estiver selecionado ou nao, o Botao de Save File da aba Alert XX.XX.XXXX (Level 2) nao funciona quando o file ja salvo no Alert XX.XX.XXXX e é aberto novamente pelo time do Level 2 e ao tentar salvar o mesmo usando o Save File no Alert XX.XX.XXXX (Level 2). (porém isso é exatamente o que preciso corrigir, pois o time do Level 2 usa o arquivo salvo pelo Alert XX.XX.XXXX para fazer as mudancas necessarias e salva como um novo aquivo). Este codigo é o praticamente o mesmo para o botao Salve File no Alert XX.XX.XXXX preciso modificar umas coisas (como informações que se deve aparecer no closing note), porém essas mudancas nao irao interferir com o Botao salvar. Talvez tu consegue ver onde esta meu erro e o por que se uso o arquivo do excel ja salvo (ja com o nome alterado ex: Cien 03.26.2020 o mesmo noa pode ser salvo como um novo arquivo alterando o nome como se é esperado ex: Cien 03.26.2020 (Level 2) ?? mais uma vez muito obrigada. 'Salve Fale na Aba Alert XX.XX.XXXX Sub SaveFile() Dim ws As Worksheet Call RemLink If ClientReview.Visible = True Then Set Client = ClientReview Else For Each ws In ActiveWorkbook.Worksheets If ws.Name Like "Client Review*" Then Set Client = ws End If Next ws End If If CheckForPics = False Then Exit Sub If CalculationSheet.Range("AP1").Value = True Or CalculationSheet.Range("AP2").Value = True Or CalculationSheet.Range("AP3").Value = True Or CalculationSheet.Range("AP4").Value = True Or CalculationSheet.Range("AP5").Value = True Then If CheckforWC = False Then Exit Sub End If If NotFilled = False Then Exit Sub If NotFilledRules = False Then Exit Sub If NotFilledClient = False Then Exit Sub If Client.Range("H1").Value <> "" Then If CalculationSheet.Range("AP6").Value = True Then Debug.Print "Works" If CheckForClientWC = False Then Exit Sub End If If CheckForClientNegative = False Then Exit Sub End If Alert.Cells.CheckSpelling ClientReview.Cells.CheckSpelling If Application.ActiveWorkbook.Path = Environ("userprofile") & "\Desktop\Investigations" Then ActiveWorkbook.Save MsgBox " File has been saved successfully." Exit Sub End If ClientReview.Activate today = Format(Date, "MM.DD.YYYY") Range("C6").Value = today savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") UserName = Application.UserName Alert.Visible = xlSheetVisible Alert.Activate Range("C1").Value = UserName Alert.Name = "Alert " & today If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations") End If On Error GoTo ErrorMessage ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & ".xls" MsgBox "File has been successfully saved to investigations folder in user's desktop." Exit Sub ErrorMessage: MsgBox "Something went wrong, file not saved!" End Sub Sub SaveFileWithoutAlertTab() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag Call RemLink If CalculationSheet.Range("AP6").Value = True Then If CheckForClientWC = False Then Exit Sub End If If CheckForClientNegative = False Then Exit Sub If NotFilledClient = False Then Exit Sub ClientReview.Cells.CheckSpelling ClientReview.Activate today = Format(Date, "MM.DD.YYYY") Range("C6").Value = today savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") UserName = Application.UserName If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations") End If Alert.Visible = xlSheetVeryHidden On Error GoTo ErrorMessage ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & ".xls" Alert.Visible = xlSheetVisible Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True MsgBox "File has been successfully saved to investigations folder in user's desktop." Exit Sub ErrorMessage: MsgBox "Something went wrong, file not saved!" End Sub Sub CopyPasteFromDownloadedClientReviewSheet() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag ClientReviewTabIsHided = False ClientReview.Visible = xlSheetVeryHidden ClientReview.Name = "Original Client Review" On Error GoTo ErrorTrue Worksheets(1).Activate Dim ws As Worksheet Dim DownloadedClientReviewSheet As Worksheet today = Format(Date, "MM.DD.YYYY") For Each ws In ThisWorkbook.Worksheets ws.Activate If ws.Name Like "Client Review*" Then Set DownloadedClientReviewSheet = ActiveSheet DownloadedClientReviewSheet.Name = "Client Review" & " " & today GoSub CopyPasteFromDownloadedClientReview Exit For End If Next ws CopyPasteFromDownloadedClientReview: Range("C1:C2").Select Selection.Copy Alert.Activate Range("C2").PasteSpecial xlPasteValues 'Unmerge client summary in Alert sheet to make it available for pasting 'Range("K16").UnMerge 'DownloadedClientReviewSheet.Activate 'DownloadedClientReviewSheet.Range("H1:H2").Value = "" 'Range("J3:L8").UnMerge 'Range("J3").Copy 'Alert.Activate 'Range("K16").PasteSpecial xlPasteValues 'Range("K16:Q22").Merge 'DownloadedClientReviewSheet.Activate Alert.Range("K16").Value = "='" & DownloadedClientReviewSheet.Name & "'!J3" 'Range("J3:L8").Merge 'Alert.Activate ClientReviewTabIsHided = True Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True Exit Sub ErrorTrue: ClientReview.Visible = xlSheetVisible ClientReview.Name = "Client Review" Alert.Activate Range("K16:Q22").Merge MsgBox "No manually added sheets identified." End Sub Sub ClearAll() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag 'Delete all pictures Dim Sh As Shape Dim sheetnumber As Integer Dim ws As Worksheet Dim starting_ws As Worksheet VBanswer = MsgBox("Do you want to refresh the template?", vbYesNo, "Refresh Template") If VBanswer = vbYes Then GoSub ClearOut Else Exit Sub End If ClearOut: Alert.Visible = xlSheetVisible Alert.Name = "Alert XX.XX.XXXX" ClientReview.Visible = xlSheetVisible ClientReview.Name = "Client Review" Worksheets(1).Select Set starting_ws = ActiveSheet For Each ws In ThisWorkbook.Worksheets ws.Activate If ws.Name <> "Client Review" And ws.Name <> "Alert XX.XX.XXXX" And ws.Name <> "Closing Notes" And ws.Name <> "EmailData" And ws.Name <> "Red Flags" And ws.Name <> "AutoRules" And ws.Name <> "PivotBene" And ws.Name <> "Version Control" And ws.Name <> "Clc" And ws.Name <> "Countries" And ws.Name <> "Transaction Details" And ws.Name <> "Pivot" And ws.Name <> "Business Rule Justifications" And ws.Name <> "12 Months" And ws.Name <> "RFI Submition Contacts" And ws.Name <> "RFI Questions" And ws.Name <> "Exceptions" And ws.Name <> "12_Months_Pivot" Then ActiveSheet.Delete End If Next 'Dim wbBook As Workbook 'Dim nName As Name 'Set wbBook = ActiveWorkbook 'For Each nName In wbBook.Names 'nName.Delete 'Next nName For sheetnumber = 1 To Sheets.count For Each Sh In Sheets(sheetnumber).Shapes If Sh.Type = msoPicture Then Sh.Delete Next Next sheetnumber 'clear named ranges 'CLIENT REVIEW TAB Sheets("Client Review").Activate Range("C1:C3").Value = "" Range("C6").Value = "" Range("H1:H2").Value = "" Range("G8:H12").Value = "" Range("J3").Value = "The client has been with WUBS since XXX and has been incorporated since MMDDYY. The expected average transaction volume in currency is YYY and the expected average frequency is ZZZ payments YXX. The client transacts with the following location(s) XXX. The client [ClientDescription] and intends to use WUBS for [PayPurpose]. Further information is located in client's Sales Force profile." 'comments Sheets("Client Review").Range("C214:G217").Value = "" Sheets("Client Review").Range("C150:G153").Value = "" Sheets("Client Review").Range("C108:G111").Value = "" Sheets("Client Review").Range("g59:G65").Value = "" Range("C59:F59").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 1"")" Range("C60:F60").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 2"")" Range("C61:F61").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 3"")" Range("C62:F62").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 4"")" Range("C63:F63").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 5"")" Range("C64:F64").FormulaR1C1 = "=IF(R[-63]C[5]<>"""",R[-63]C[5],""Client name for search"")" Range("C65:F65").FormulaR1C1 = "=IF(R[-63]C[5]<>"""",R[-63]C[5],""Trading name for search"")" 'ALERT TAB Alert.Activate Range("C1").Value = "" Range("H2:L6").Value = "" Range("O2").Value = "" Range("B16").Value = CalculationSheet.Range("Default_Closing_Notes").Value Range("K16:Q22").Merge Range("C2").FormulaR1C1 = "=IF('Client Review'!R[-1]C<>"""",'Client Review'!R[-1]C,"""")" Range("C3").FormulaR1C1 = "=IF('Client Review'!R[-1]C<>"""",'Client Review'!R[-1]C,"""")" Range("K16").FormulaR1C1 = "='Client Review'!R[-13]C[-1]" Range("C66").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 1"")" Range("C67").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 2"")" Range("C68").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 3"")" Range("C69").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 4"")" Range("C70").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 5"")" 'Delete all comments Alert.Range("C318:G321").Value = "" Alert.Range("C270:G273").Value = "" Alert.Range("C230:G233").Value = "" Alert.Range("C189:G192").Value = "" Alert.Range("C148:G151").Value = "" Alert.Range("C107:G110").Value = "" Alert.Range("G66:G70").Value = "" Countries.Visible = False Grid.Visible = False Pivot.Visible = False CalculationSheet.Visible = False Avarage.Visible = False PivotBene.Visible = False AutoRules.Visible = False RedFlagss.Visible = False ClientReview.Range("C23").Value = "" CalculationSheet.Range("B100:B121").Value = "FALSE" CalculationSheet.Range("OutTransactionsStartDate").Value = "XXZ" CalculationSheet.Range("OutTransactionsEndDate").Value = "YYX" CalculationSheet.Range("broken_rules").Value = "ZZX" CalculationSheet.Range("rules_count").Value = "" CalculationSheet.Range("BeneficiaryInfoFromTable").Value = CalculationSheet.Range("K7").Value CalculationSheet.Rows("150:" & Rows.count).ClearContents CalculationSheet.Range("RulesForWhiteListing").Value = "" CalculationSheet.Range("RuleCountToWhiteList").Value = "" CalculationSheet.Range("RulesJustification").Value = CalculationSheet.Range("K9").Value CalculationSheet.Range("Ending").Value = CalculationSheet.Range("K3").Value CalculationSheet.Range("redflags").Value = CalculationSheet.Range("K5").Value CalculationSheet.Range("Benecc").Value = "XXX" CalculationSheet.Range("C6").Value = "" CalculationSheet.Range("AP1:AP6").Value = "False" ClientReview.Range("D67").Value = "" EmailData.Cells.Clear Pivot.Cells.Clear Grid.Cells.Clear Avarage.Cells.Clear Alert.Range("P2").Value = "" Alert.Range("D32").Value = "" CalculationSheet.Range("I2:I" & CalculationSheet.Cells(Rows.count, 9).End(xlUp).Row).Value = "" ClientReview.Range("C67").Value = "" ClientReview.Range("D67").Value = "" ClientReview.Range("C114").Value = "" CalculationSheet.Range("C3:H30").Value = "" avarage_pivot.Visible = False On Error Resume Next PivotBene.PivotTables("BeneNames").TableRange2.Clear On Error GoTo 0 On Error Resume Next ActiveWorkbook.SlicerCaches("Slicer_Bene_Names").Delete On Error GoTo 0 On Error Resume Next ActiveWorkbook.SlicerCaches("Slicer_Dates").Delete On Error GoTo 0 On Error Resume Next ActiveWorkbook.SlicerCaches("Slicer_Bene_Name").Delete On Error GoTo 0 On Error Resume Next ActiveWorkbook.SlicerCaches("Slicer_Bene_Name1").Delete On Error GoTo 0 AutoRules.Range("E2:Z50").Clear PivotBene.Rows("2:" & Rows.count).ClearContents avarage_pivot.Rows.Delete Application.GoTo Reference:=Range("a1"), Scroll:=True Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True MsgBox "Template has been refreshed.", vbOKOnly, "Information" End Sub Private Sub Workbook_Open() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False Dim openPath, FilePath As String Dim data_file As Workbook Set WBMain = ThisWorkbook openPath = Environ("userprofile") FilePath = (openPath & "\Box\WUBS GAI & SAR REPORTING\Distribution lists (IRIS TMS case, World-Check, Fintrac)\Distribution WU WAY\Data for Templates.xlsx") If CalculationSheet.Range("A25").Value <> FileDateTime(FilePath) Then exceptions.Rows.Clear rfi_contacts.Rows.Clear rfi_questions.Rows.Clear Set data_file = Workbooks.Open(openPath & "\Box\WUBS GAI & SAR REPORTING\Distribution lists (IRIS TMS case, World-Check, Fintrac)\Distribution WU WAY\Data for Templates.xlsx") data_file.Sheets("RFI Submition Contacts").Range("A:M").Copy rfi_contacts.Range("A1") data_file.Sheets("RFI Questions").Range("A:C").Copy rfi_questions.Range("A1") data_file.Sheets("Rule Exceptions").Range("A:C").Copy exceptions.Range("A1") data_file.Close CalculationSheet.Range("A25").Value = FileDateTime(FilePath) End If Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True End Sub -- ----------- -- 'Salve File na Aba Alert XX.XX.XXXX (Level 2) Option Explicit Sub Save_Level_2_File() Dim ws As Worksheet Dim Client As ClientReview Call RemLink2 If ClientReview.Visible = True Then Set Client = ClientReview Else For Each ws In ActiveWorkbook.Worksheets If ws.Name Like "Client Review*" Then Set Client = ws End If Next ws End If If CheckForPics2 = False Then Exit Sub If CalculationSheet.Range("AR1").Value = True Or CalculationSheet.Range("AR2").Value = True Or CalculationSheet.Range("AR3").Value = True Or CalculationSheet.Range("AR4").Value = True Or CalculationSheet.Range("AR5").Value = True Then If CheckforWC = False Then Exit Sub End If If NotFilled = False Then Exit Sub If NotFilledRules = False Then Exit Sub If NotFilledClient = False Then Exit Sub If Client.Range("H1").Value <> "" Then If CalculationSheet.Range("AR6").Value = True Then Debug.Print "Works" If CheckForClientWC = False Then Exit Sub End If If CheckForClientNegative = False Then Exit Sub End If Alert1.Cells.CheckSpelling ClientReview.Cells.CheckSpelling If Application.ActiveWorkbook.Path = Environ("userprofile") & "\Desktop\Investigations" Then ActiveWorkbook.Save MsgBox " File has been saved successfully." Exit Sub End If Dim today As String Dim savePath As String Dim CompanyName As String Dim UserName As String ClientReview.Activate today = Format(Date, "MM.DD.YYYY") Range("C6").Value = today savePath = Environ("userprofile") 'get unique path for every user CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value CompanyName = Replace(CompanyName, "&", "") CompanyName = Replace(CompanyName, "/", "") CompanyName = Replace(CompanyName, "\", "") CompanyName = Replace(CompanyName, ":", "") CompanyName = Replace(CompanyName, "*", "") CompanyName = Replace(CompanyName, "?", "") CompanyName = Replace(CompanyName, Chr(34), "") CompanyName = Replace(CompanyName, "<", "") CompanyName = Replace(CompanyName, ">", "") CompanyName = Replace(CompanyName, "|", "") UserName = Application.UserName Alert1.Visible = xlSheetVisible Alert1.Activate Range("C1").Value = UserName Alert1.Name = "Alert " & today & " (Level 2)" ' button save file Level 2 If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then MkDir (savePath & "\Desktop\Investigations") End If On Error GoTo ErrorMessage ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & " (Level 2)" & ".xls" MsgBox "File has been successfully saved to investigations folder in user's desktop." Exit Sub ErrorMessage: MsgBox "Something went wrong, file not saved!" End Sub Sub CopyPasteFromDownloadedClientReviewSheet() Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag ClientReviewTabIsHided = False ClientReview.Visible = xlSheetVeryHidden ClientReview.Name = "Original Client Review" On Error GoTo ErrorTrue Worksheets(1).Activate Dim ws As Worksheet Dim DownloadedClientReviewSheet As Worksheet today = Format(Date, "MM.DD.YYYY") For Each ws In ThisWorkbook.Worksheets ws.Activate If ws.Name Like "Client Review*" Then Set DownloadedClientReviewSheet = ActiveSheet DownloadedClientReviewSheet.Name = "Client Review" & " " & today & "" & "(Level 2)" GoSub CopyPasteFromDownloadedClientReview Exit For End If Next ws CopyPasteFromDownloadedClientReview: Range("C1:C2").Select Selection.Copy Alert1.Activate Range("C2").PasteSpecial xlPasteValues 'Unmerge client summary in Alert sheet to make it available for pasting 'Range("K16").UnMerge 'DownloadedClientReviewSheet.Activate 'DownloadedClientReviewSheet.Range("H1:H2").Value = "" 'Range("J3:L8").UnMerge 'Range("J3").Copy 'Alert.Activate 'Range("K16").PasteSpecial xlPasteValues 'Range("K16:Q22").Merge 'DownloadedClientReviewSheet.Activate Alert.Range("K16").Value = "='" & DownloadedClientReviewSheet.Name & "'!J3" 'Range("J3:L8").Merge 'Alert.Activate ClientReviewTabIsHided = True Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True Exit Sub ErrorTrue: ClientReview.Visible = xlSheetVisible ClientReview.Name = "Client Review" Alert.Activate Range("K16:Q22").Merge MsgBox "No manually added sheets identified." End Sub Sub RemLink2() 'Excel VBA remove links from workbook. Dim ar As Variant Dim i As Integer ar = ActiveWorkbook.LinkSources(1) On Error Resume Next 'Trap error For i = 1 To UBound(ar) 'Excel VBA loop throuh links ActiveWorkbook.BreakLink ar(i), xlLinkTypeExcelLinks Next i On Error GoTo 0 End Sub Function CheckForPics2() As Boolean Dim ReturnValue As Boolean Dim nm As String Dim picBox As Integer Dim i As Long Dim tnm As String CheckForPics2 = True For i = 2 To 6 If Range("H" & i).Value <> "" Then picBox = i ReturnValue = CheckPic2(picBox) Dim result As String If ReturnValue = False Then tnm = CalculationSheet.Range("W" & i).Value result = MsgBox("No screenshots for " & tnm & " were found." & vbNewLine & "Do you still want to save file?", vbYesNo + vbQuestion + vbDefaultButton2) If result = vbNo Then CheckForPics2 = False Exit For Else: CheckForPics2 = True End If Else: CheckForPics2 = True End If Else Exit For End If Next i End Function Function CheckPic2(xRg As Integer) As Boolean Dim Client As Object Dim xpicRg As Range Dim nRg As String Dim nRg1 As Integer Dim nRg2 As Integer Dim ws As Worksheet If ClientReview.Visible = True Then Set Client = ClientReview Else For Each ws In ActiveWorkbook.Worksheets If ws.Name Like "Client Review*" Then Set Client = ws End If Next ws End If If xRg < 7 Then Alert1.Activate Else Client.Activate End If nRg = CalculationSheet.Range("V" & xRg).Value nRg1 = Split(nRg, ":")(0) nRg2 = Split(nRg, ":")(1) Debug.Print "ngr1: " & nRg1 Debug.Print "nrg2: " & nRg2 Dim xPic As Object For Each xPic In ActiveSheet.Pictures Debug.Print "xPic: " & xPic.TopLeftCell.Row If xPic.TopLeftCell.Row >= nRg1 And xPic.TopLeftCell.Row <= nRg2 Then Debug.Print "Ok" CheckPic2 = True Exit For Else CheckPic2 = False End If Next End Function Function NotFilled2() As Boolean Dim vl As String Dim Mnm As String Dim spos As Long Dim i As Integer Dim lenghts As Integer Dim result As Integer For i = 2 To 10 vl = CalculationSheet.Range("Z" & i).Value Mnm = CalculationSheet.Range("AA" & i).Value If InStr(Alert1.Range("B16").Value, vl) Then Alert1.Activate Alert1.Range("B16").Select spos = InStr(Alert1.Range("B16").Value, vl) lenghts = Len(vl) Alert1.Range("B16").Characters(Start:=spos, Length:=lenghts).Font.ColorIndex = 3 Alert1.Range("B16").Characters(Start:=spos, Length:=lenghts).Font.Bold = True result = MsgBox(Mnm & " was not entered in Closing Notes." & vbNewLine & "Do you still want to save file?", vbYesNo + vbQuestion + vbDefaultButton2) If result = vbYes Then NotFilled2 = True Else NotFilled2 = False Exit For End If Else: NotFilled2 = True End If Next i End Function

@osvaldomp Muito Obrigada, Muito Obrigada, esta funcionando perfeitamente. Eu criei um Botao para iniciar o macro e assign o Macro a ele e esta funcionando perfeitamente. porém, eu notei que se alguma Checkbox da coluna M (L2) estiver selecionanda quando clico no botao Save File (no alert XX.XX.XXXX (Level 2) ) o mesmo nao funciona (ele salva o arquivo como se fosse a aba Alert XX.XX.XXXX, ou seja ele salva sobre o arquivo que ja estava salvo como o nome (do alerta Data ) sem o (Level 2) no final. teria algum motivo para isso? Ja se nenhuma checkbox estiver selecionada o botao Salve File da aba Alert XX.XX.XXXX (Level 2) funcionando perfeitamente como se deve. A maneira que os arvivos devem salvar o arquivo quando for clicado: No me do alerta + data (por exemplo o nome do alerta é "Cien") Se o botao Save File na aba Alert XX.XX.XXXX for selecionado o arquivo sera automaticamente salvo como: Cien 03.26.2020 Se o botao Save File na aba Alert XX.XX.XXXX (Level 2) for selecionado o arquivo sera automaticamente salvo como: Cien 03.26.2020 (Level 2) Seria possivel por uma linha no codigo para que se a checkbox esteja ou nao selecionada nao afete na hora que o save file botao do Alert XX.XX.XXXX (Level 2) seja selecionado? Obrigada pelo seu tempo.

@osvaldomp consegui anexar o arquivo (mas o macro não aparece, porém ja da para ter uma ideia) @Patropi Bom dia, Muito obrigada pela ajuda. A primeira parte esta funcionando perfeitamente, porém não consigo corrigir a formula para as informações aparecerem na tabela da aba Alert XX.XX.XXXX (Level 2). eu tentei esta formula. =IFERROR(INDEX(ALERT XX.XX.XXXX!$H$2:$H$7,MATCH(ROW(A1),Clc!$AT$2:$AT$7,0))),'')&'' ROW(A1) não entendi esta parte da formula. (meu excel esta em inglês normalmente quando tenho " no meu seria ') consegui anexar o excel file (porém o macro não aparece nenhum...) eu creio que se fosse VBA não teria problema quando o nome da aba muda. A aba sempre que clica no botao salvar ira mudar o nome dapara a cada do dia (entao não sei se isso aferatia as checkbox). muito obrigada pela ajuda

@osvaldomp Infelizmente o meu excel esta restrito e mesmo que coleque o arquivo aqui não conseguira abrir em outro computador. sim voce esta correto, Alert e Alert1 sao os nomes da tab (irei colocar um print melhor). O que quero é copiar as informações que esteja disponivel na tabela da tab Alert (porém apenas se o checkbox estiver selecionado na coluna M (L2)). Sinceramente não sei usar checkbox, não sei se para isso necessito o form controls ou activeXcontrol. muito Obrigada.

Ola pessoal. Desculpe usar esse mesmo post, mas minha duvida esta relacionada. Sou nova no VBA e não sei nada sobre checkbox, pesquisei em varios sites e tentei varios codigos, porém nenhum funciona como preciso. Eu tenho um workbook com varias tabs, porém necessiro copiar informações de uma tabela na tab Alert para a mesma tabela na Tab Alert1 somente se a checkbox na coluna L2 estiver selecionada. (posso usar um botao na tab Alert1 para copiar as linhas da tabela que tiver o checkbox selecionado na colina L2). obrigada