Looping & Selection + Loop

Benzula

Board Regular
Joined
Feb 28, 2014
Messages
248
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

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 IDCustomerCompliance NotesOpen OpportunitiesOpen Opp Device LevelAccount Executive - AccountMDM - ActiveMDM - PurchasedMDM- AvailableAW Email ClientAW CLAW BRAW WSSF Account StatusHosting Model
123456789dsaABC Corp TRUE-UP - ABC Corp15John Rhodes8670-160900ActiveAW SaaS

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

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
here is the simple solution:

Code:
Dim sheetNo as Integer

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

Next
 
Upvote 0
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.

Code:
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
 
Upvote 0
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>
 
Upvote 0
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.
 
Upvote 0
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.

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
 
Upvote 0
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.

Code:
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,915
Members
448,532
Latest member
9Kimo3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top