Email VBA not working

Jase L

New Member
Joined
Sep 16, 2006
Messages
13
Sub Mail_sheets()
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String
For a = 1 To 253 Step 3
If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then
Exit Sub
End
Application.ScreenUpdating = False
last = ThisWorkbook.Sheets("mail").Cells(Rows.Count, _
a).End(xlUp).Row
N = 0
For shname = 1 To last
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname, a).Value
Next shname
ThisWorkbook.Sheets(Arr).Copy
strdate = Format(Date, "dd-mm-yy") & " " & _
Format(Time, "h-mm-ss")
ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
With ThisWorkbook.Sheets("mail")
MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, _
a + 1).End(xlUp))
End With
ActiveWorkbook.SendMail MyArr, ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Next a
End Sub

Produces an error of Compile Error: Next without For

Any ideas?!
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,884
Hi Jase

You don't close the IF block. Instead of

If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then
Exit Sub
End

this:

If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then
Exit Sub
End If

Hope this helps
PGC
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,299
Office Version
  1. 365
Platform
  1. Windows
Not 100% sure what you are trying to do but this compiles.
Code:
Sub Mail_sheets()
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String

    Application.ScreenUpdating = False
    
    For a = 1 To 253 Step 3
        If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then
            Exit Sub
        End If
    
        last = ThisWorkbook.Sheets("mail").Cells(Rows.Count, a).End(xlUp).Row
        
        For shname = 1 To last
            N = N + 1
            ReDim Preserve Arr(1 To N)
            Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname, a).Value
        Next shname
        
        ThisWorkbook.Sheets(Arr).Copy
        strdate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
        ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name & " " & strdate & ".xls"
        
        With ThisWorkbook.Sheets("mail")
            MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, a + 1).End(xlUp))
        End With
        
        ActiveWorkbook.SendMail MyArr, ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value
        ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill ActiveWorkbook.FullName
        ActiveWorkbook.Close False
        
    Next a
    
    Application.ScreenUpdating = True
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,133,651
Messages
5,660,127
Members
418,550
Latest member
kp_

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
Top