Looping & Selection + Loop

[Benzula]

Okay guys. I got a simple question, and a Complex question.

Simple. I need to run this Macro on every sheet in a workbook. I have it so it works on the current active sheet.

So I assume a simple Loop with this Macro would allow me to do it, how would I structure so that it goes to the next tab regardless of what it is called.

Here is the current code

Sub Send_Selection_Or_ActiveSheet_with_MailEnvelope()
'Working in Excel 2002-2013
    Dim Sendrng As Range
    
    On Error GoTo StopMacro


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Note: if the selection is one cell it will send the whole worksheet
    Set Sendrng = Selection


    'Create the mail and send it
    With Sendrng


        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope


            ' Set the optional introduction field thats adds
            ' some header text to the email body.
            .Introduction = "Good Afternoon, " & vbNewLine & vbNewLine & "Below you will find your accounts. 


            With .Item
                .To = ActiveSheet.Name
                .CC = ""
                .BCC = ""
                .Subject = "Please find below a list of all of your accounts."
                .Send
            End With


        End With
    End With


StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False


End Sub

Okay! Now for the the more complex problem. Below is a sample (No Real Data)

If I have multiple rows of customers, they are all sorted by smallest to largest on MDM - Available.

What i need is to have the macro above run, but select the header +all rows that have negative MDM - Available. So if there were 3 more in addition to the one below with -10, -3 , 7. It would only select to send the first one + the ones with -10 and -3 with the header.

This is variable number of records per tab. So tab 2 could have 10 records with negative MDM - Available, and tab 3 could have 3.

Also If there are no records with negative numbers, I would want it to SKIP.

Again would need this to loop to each tab.

SalesForce ID

Customer

Compliance Notes

Open Opportunities

Open Opp Device Level

Account Executive - Account

MDM - Active

MDM - Purchased

MDM- Available

AW Email Client

AW CL

AW BR

AW WS

SF Account Status

Hosting Model

123456789dsa

ABC Corp

TRUE-UP - ABC Corp

15

John Rhodes

86

70

-16

0

9

0

0

Active

AW SaaS

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[par60056]

here is the simple solution:

Dim sheetNo as Integer

for sheetNo=1 to sheets.count
   Sheets(sheetNo).activate
' do everything

Next

 

[Benzula]

Thank you Par60056 for the response! Where do I put that in my Code?

 

[Peter Thompson]

Hello,

For you second problem try the below as I wasn't sure what actions you wanted to take when you selected the rows I ave just made it copy the data to a new workbook. You can replace these actions with whatever actions you want to take. The place to put you actions is highlighted.

For Each Worksheet In Worksheets

Dim wksCurrentWorksheet As Worksheet
Set wksCurrentWorksheet = ActiveSheet
    
    'Find the lastrow in column A
    Dim lnglastrow As Long
    lnglastrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ActiveSheet.Range("$A$1:$O$" & lnglastrow).AutoFilter Field:=9, Criteria1:="<0", _
        Operator:=xlAnd
        
        Dim lngCountVisibleRows As Long
        lngCountVisibleRows = Range("A1:A" & lnglastrow).SpecialCells(xlCellTypeVisible).Count
        
        
        If lngCountVisibleRows > 1 Then
        
       ''''replace with whatever actions you want below
       ''''NOTE YOU WILL NEED TO ADAPT THE BELOW LINE TO DO WHAT YOU WANT - EG YOU COULD SELECT RATHER '''THAN COPY IF YOU WANT SpecialCells are the key to what you want to do.
        
        Range("$A$1:$O$" & lnglastrow).SpecialCells(xlCellTypeVisible).Copy
    
   
    
        Sheets.Add After:=ActiveSheet  ''replace
        ActiveSheet.Paste ''replace
    
    
       ''''''ENd of your actions
        wksCurrentWorksheet.AutoFilterMode = False
        
        Application.CutCopyMode = False
        
        Else
        
        End If
        
Next Worksheet

Hope this helps

Peter

 

[Peter Thompson]

Also you asked where you should put the code par0056 gave you. You should put all the actions you want to happen for each sheet where par0056 has put

' do everything

If you were you I would move the section below and it's reverse outside of the loop.

With Application .ScreenUpdating = False .EnableEvents = False End With

Peter
</pre>

 

[Benzula]

Excellent! I got the first code to work. Now I'm going to try and alter your code so it will work too.

Thanks I'll let you know the progress.

 

[Benzula]

Ok it looks like when I put the macros' together, that is sends the first page 4 times instead of each page once, and then it sends all of the pages.

The first page it says 4 times, comes out right with just the lines needed, but the rest of the pages, send all of them. Here is my amalgamation of the code.

Sub TestSend()




For Each Worksheet In Worksheets


Dim wksCurrentWorksheet As Worksheet
Set wksCurrentWorksheet = ActiveSheet
    
    'Find the lastrow in column A
    Dim lnglastrow As Long
    lnglastrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ActiveSheet.Range("$A$1:$O$" & lnglastrow).AutoFilter Field:=9, Criteria1:="<0", _
        Operator:=xlAnd
        
        Dim lngCountVisibleRows As Long
        lngCountVisibleRows = Range("A1:A" & lnglastrow).SpecialCells(xlCellTypeVisible).Count
        
        
        If lngCountVisibleRows > 1 Then
        
        
        
        
        
        
        
      Dim sheetNo As Integer


For sheetNo = 1 To Sheets.Count
   Sheets(sheetNo).Activate
   
    Dim Sendrng As Range
    
    On Error GoTo StopMacro


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Note: if the selection is one cell it will send the whole worksheet
    Set Sendrng = Selection


    'Create the mail and send it
    With Sendrng


        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope


            ' Set the optional introduction field thats adds
            ' some header text to the email body.
            .Introduction = "Good Afternoon, " & vbNewLine & vbNewLine & "Below you will find your accounts that are currently out of compliance.


            With .Item
                .To = ActiveSheet.Name
                .CC = ""
                .BCC = ""
                .Subject = "Please find below a list of all of your our of compliance accounts."
                .Send
            End With


        End With
    End With
Next




       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
        wksCurrentWorksheet.AutoFilterMode = False
        
        Application.CutCopyMode = False
        
        Else
        
        End If
        
Next Worksheet


StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False
End Sub

 

[Peter Thompson]

I think part of your problem is that you have put one loop inside another i.e. you have combined the for and each method in my example with the looping method provided b par0056. Try the below.

Sub testsend()

 With Application
 .ScreenUpdating = False
 .EnableEvents = False
  End With


For Each Worksheet In Worksheets

        Dim wksCurrentWorksheet As Worksheet
        Set wksCurrentWorksheet = ActiveSheet
            
            'Find the lastrow in column A
            Dim lnglastrow As Long
            lnglastrow = Cells(Rows.Count, 1).End(xlUp).Row
            
            ActiveSheet.Range("$A$1:$O$" & lnglastrow).AutoFilter Field:=9, Criteria1:="<0", _
                Operator:=xlAnd
                
                Dim lngCountVisibleRows As Long
                lngCountVisibleRows = Range("A1:A" & lnglastrow).SpecialCells(xlCellTypeVisible).Count
                
                
                If lngCountVisibleRows > 1 Then
                
            
                         
            Dim Sendrng As Range
            
            On Error GoTo StopMacro

            'Note: if the selection is one cell it will send the whole worksheet
            Set Sendrng = Selection


            'Create the mail and send it
            With Sendrng


                ActiveWorkbook.EnvelopeVisible = True
                With .Parent.MailEnvelope


                    ' Set the optional introduction field thats adds
                    ' some header text to the email body.
                    .Introduction = "Good Afternoon, " & vbNewLine & vbNewLine & "Below you will find your accounts that are currently out of compliance."


                    With .Item
                        .To = ActiveSheet.Name
                        .CC = ""
                        .BCC = ""
                        .Subject = "Please find below a list of all of your our of compliance accounts."
                        .Send
                    End With


                End With
            End With
        

              
                wksCurrentWorksheet.AutoFilterMode = False
                
                Application.CutCopyMode = False
                
                Else
                
                End If
                
        Next Worksheet


StopMacro:
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
            ActiveWorkbook.EnvelopeVisible = False
        End Sub

 

[Benzula]

I tried that one, and it is sending 4 of the same e-mail to the same person.

 

[Peter Thompson]

Sorry to hear that, not quite sure why that would be the case as this is a simple for and next loop, which just loops through all the worksheets in the worksheets collection.
I assume that there are no duplicated worksheets within the workbook? I am clutching at straws so I thought it was worth asking.
Have you tried stepping through the code and seeing what its doing?
I would test the code myself but my email isn't set up to do this.