• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA - Auto Email from Cell Value

Mikee85

New Member
Hi,

Could someone help me with my query please? I have attached a sample spreadsheet for reference.

I’m a novice at VBA (very, very Basic understanding of VBA) and have tried multiple attempts with no avail.

I would like to create a VBA code to allow me to do the following;


Ø Check Column K (follow up date) and see if the any cells match todays date.

Ø If query is satisfied it has found a cell with todays date, then send an email automatically to an addressee.

Ø Email to include, a comment and use information from that same row from columns C & D new line and then Previous Comments: = Column L.

Ø Once this has been done, it can only be sent once until that cell is then amended (normally a future date, and when that date becomes todays date it would send again) so the same emails are not sent every time the spreadsheet is opened in that day.

Ø This to be effective across 6 worksheets within the same work book.

Secondary query, I would also like for a query for Column G. If the date in column G is older than todays’ date (yesterday and back), then entire row is moved to ‘Archive’ worksheet on the next available row and the worksheet where the row was moved from is deleted so the spreadsheet doesn’t contain multiple gaps.

Is this possible as I’ve tried multiple versions but as I have limited experience I’m stuck.


Thank you so much in advance for any help provided.

Kind regards
 

Attachments

  • M_Sample-E.xlsx
    84 KB · Views: 9
Welcome to the forum!

I guess the email would be to yourself? There is no field for "addressee". Send one email for all or one per row? Send as plain text, or html which can include signature, or WordEditor method which can include custom signature from RTF file?
 
Hi Kenneth,

Thank you for your reply. Yes email to myself and one other.

HTML & separate Email for each row please!

Thank you
 
Here is part one, the email part.

Change values in the INPUT area to suit. Note the path and name for your signature.htm file. I am not a big fan of the htmlBody method since the signature htm file data with graphics does not come in well. I prefer the WordEditor method.

When you see double double quotes, that means that (BR) was inside but ()'s are <>'s. This is because text here is html. BR with the <> signs is html for vbCrLf.

Look at the construction of the subj (subject) and bod (body). Once you run it, you can see what you might want to change. I recommend just doing one row with the date in column K as today to test. Once it works, uncomment Send and comment out Display or delete it.

Remove the trailing space character in your tab name "Archive " or change code to use that name.

Code:
Sub Main1() 'Send emails for each row in each sheet where column K/11=Today
  Dim ws As Worksheet, aws As Worksheet, i As Long, j As Integer, calc As Integer
  Dim T$, CC$, td As Date, r As Range, rr As Range, sig$, htmSig$, rw As Long
  Dim subj$, bod$
  Dim OutApp As Object, OutEmail As Object
  'Tools > References > Microsoft Outlook xx.0 Object Library
  'Dim OutApp As New Outlook.Application, OutEmail As Outlook.MailItem

'*********** Set Inputs *************************************************
  T = "ken@gmail.com"
  CC = "ken@yahoo.com"
  htmSig = "std"
'*********** End Inputs *************************************************

  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With

  'signature, http://www.rondebruin.nl/win/s1/outlook/signature.htm
  sig = Environ("appdata") & "\Microsoft\Signatures\" & htmSig & ".htm"
  If Dir(sig) <> "" Then
    sig = GetBoiler(sig)  'Get html text.
    Else: sig = ""
  End If

  td = Date 'Today
  Set aws = Worksheets("Archive")

  Set OutApp = CreateObject("Outlook.Application")

  'With OutEmail
  For j = 1 To aws.Index - 1
    Set ws = Worksheets(j)
    With ws
      If .AutoFilterMode = True Then .AutoFilterMode = False
      .UsedRange.AutoFilter 11, td
      Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
      If r.Areas.Count = 1 Then GoTo NextJ  'No data in filter.
      For Each rr In r.Areas
        If rr.Row = 1 Then GoTo NextRR  'Skip row 1 - header row
        'Add a day, prevents another run today.
        rr(, 11).Value = rr(, 11).Value + 1
        subj = .Range("C1").Value & ":  " & rr(, 3).Value & " is due today."
        bod = .Range("C1").Value & ":  " & rr(, 3).Value & "<BR>"
        bod = bod & .Range("D1").Value & ":  " & rr(, 4).Value & "<BR>"
        bod = bod & "<BR>" & .Range("L1").Value & ":  " & rr(, 12).Value & "<BR>"
        bod = bod & sig
        Set OutEmail = OutApp.CreateItem(0)  '0=olMailItem
        With OutEmail
          .BodyFormat = 2 'olFormatHTML=2, not really needed.
          .Display
          'If range to html needed, http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
          .HTMLBody = bod
          .To = T
          .CC = CC
          .subject = subj
          '.Send
          .Display
        End With
NextRR:
      Next rr
      .AutoFilter.ShowAllData
    End With
NextJ:
  Next j

  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
    .CutCopyMode = False
  End With
  On Error Resume Next
  Set OutEmail = Nothing
  Set OutApp = Nothing
End Sub


Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
 
Last edited:
As always but especially with this one, test on a backup copy.

Code:
Sub Main2() 'Archive rows to Archive Sheet
  Dim ws As Worksheet, aws As Worksheet, i As Long
  Dim j As Integer, calc As Integer
  Dim td As Date, r As Range, rr As Range
 
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With
  td = Date 'Today
  Set aws = Worksheets("Archive")
 
  For j = 1 To aws.Index - 1
    Set ws = Worksheets(j)
    With ws
      If .AutoFilterMode = True Then .AutoFilterMode = False
      .UsedRange.AutoFilter 7, "<" & td
      Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
      Set r = Intersect(r, .Rows("2:" & .Rows.Count))
      If Not r Is Nothing Then
        r.Copy aws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        r.Delete xlUp
        .AutoFilter.ShowAllData
      End If
    End With
NextJ:
  Next j
 
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
    .CutCopyMode = False
  End With
End Sub
 
This is a tweak to post #6.
Code:
Sub Main1() 'Send emails for each row in each sheet where column K/11=Today
  Dim ws As Worksheet, aws As Worksheet, i As Long, j As Integer, calc As Integer
  Dim T$, CC$, td As Date, r As Range, rr As Range, sig$, htmSig$, rw As Range
  Dim subj$, bod$
  Dim OutApp As Object, OutEmail As Object
  'Tools > References > Microsoft Outlook xx.0 Object Library
  'Dim OutApp As New Outlook.Application, OutEmail As Outlook.MailItem
 
'*********** Set Inputs *************************************************
  T = "ken@gmail.com"
  CC = "ken@yahoo.com"
  htmSig = "std"
'*********** End Inputs *************************************************

  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With

  'signature, http://www.rondebruin.nl/win/s1/outlook/signature.htm
  sig = Environ("appdata") & "\Microsoft\Signatures\" & htmSig & ".htm"
  If Dir(sig) <> "" Then
    sig = GetBoiler(sig)  'Get html text.
    Else: sig = ""
  End If
 
  td = Date 'Today
  Set aws = Worksheets("Archive")
 
  Set OutApp = CreateObject("Outlook.Application")
 
  'With OutEmail
  For j = 1 To aws.Index - 1
    Set ws = Worksheets(j)
    With ws
      If .AutoFilterMode = True Then .AutoFilterMode = False
      .UsedRange.AutoFilter 11, td
      Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
      If r.Areas.Count = 1 Then GoTo NextJ  'No data in filter.
      For Each rr In r.Areas
        If rr.Row = 1 Then GoTo NextRR  'Skip row 1 - header row
        For Each rw In rr.Rows
          'Add a day, prevents another run today.
          rw.Cells(, 11).Value = rw.Cells(, 11).Value + 1
          subj = .Range("C1").Value & ":  " & rw.Cells(, 3).Value & " is due today."
          bod = .Range("C1").Value & ":  " & rw.Cells(, 3).Value & "<BR>"
          bod = bod & .Range("D1").Value & ":  " & rw.Cells(, 4).Value & "<BR>"
          bod = bod & "<BR>" & .Range("L1").Value & ":  " & rw.Cells(, 12).Value & "<BR>"
          bod = bod & sig
          Set OutEmail = OutApp.CreateItem(0)  '0=olMailItem
          With OutEmail
            .BodyFormat = 2 'olFormatHTML=2, not really needed.
            .Display
            'If range to html needed, http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
            .HTMLBody = bod
            .To = T
            .CC = CC
            .subject = subj
            '.Send
            .Display
          End With
        Next rw
NextRR:
      Next rr
      .AutoFilter.ShowAllData
    End With
NextJ:
  Next j
 
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
    .CutCopyMode = False
  End With
  On Error Resume Next
  Set OutEmail = Nothing
  Set OutApp = Nothing
End Sub
 
Hi Kenneth,

Thank you for the coding above and your expertise, it is greatly appreciated.

I have entered the code and ran the spreadsheet but it doesn't seem to work. The rows have all closed up to row 128 when the end date in column G is applied including the title.

The email doesn't seem to populate / Display with today's date. I'm happy for it not to be HTML is there is much easier and better method.

Would you be to take a look at this for again please?

Thank you in advance
 

Attachments

  • M_Sample-E-Macro.xlsm
    96.4 KB · Views: 5
1. Put the code into a Module, not ThisWorkbook and not a Sheet object.

I added the GetBoiler() routine, and changed the Loop exit.

Change the TO (T variable value) back to your TO.

Code:
Sub Main1() 'Send emails for each row in each sheet where column K/11=Today
Dim ws As Worksheet, aws As Worksheet, i As Long, j As Integer, calc As Integer
  Dim T$, CC$, td As Date, r As Range, rr As Range, sig$, htmSig$, rw As Range
  Dim subj$, bod$
  Dim OutApp As Object, OutEmail As Object
  'Tools > References > Microsoft Outlook xx.0 Object Library
'Dim OutApp As New Outlook.Application, OutEmail As Outlook.MailItem

'*********** Set Inputs *************************************************
T = "ken@hotmail.co.uk"
  CC = ""
  htmSig = "std"
'*********** End Inputs *************************************************

  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With

  'signature, http://www.rondebruin.nl/win/s1/outlook/signature.htm
sig = Environ("appdata") & "\Microsoft\Signatures\" & htmSig & ".htm"
  If Dir(sig) <> "" Then
    sig = (sig)  'Get html text.
  Else: sig = ""
  End If
  td = Date 'Today
Set aws = Worksheets("Archive")
  Set OutApp = CreateObject("Outlook.Application")
  'With OutEmail
For j = 1 To aws.Index - 1
    Set ws = Worksheets(j)
    With ws
      If .AutoFilterMode = True Then .AutoFilterMode = False
      .UsedRange.AutoFilter 11, td
    Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
    For Each rr In r.Areas
      For Each rw In rr.Rows
          If rw.Row = 1 Then GoTo NextRW
          'Add a day, prevents another run today.
        rw.Cells(, 11).Value = rw.Cells(, 11).Value + 1
          subj = .Range("C1").Value & ":  " & rw.Cells(, 3).Value & " is due today."
          bod = .Range("C1").Value & ":  " & rw.Cells(, 3).Value & "<BR>"
          bod = bod & .Range("D1").Value & ":  " & rw.Cells(, 4).Value & "<BR>"
          bod = bod & "<BR>" & .Range("L1").Value & ":  " & rw.Cells(, 12).Value & "<BR>"
          bod = bod & sig
          Set OutEmail = OutApp.CreateItem(0)  '0=olMailItem
        With OutEmail
            .BodyFormat = 2 'olFormatHTML=2, not really needed.
          .Display
            'If range to html needed, http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
          .HTMLBody = bod
            .To = T
            .CC = CC
            .Subject = subj
            '.Send
          .Display
          End With
NextRW:
        Next rw
      Next rr
      .AutoFilter.ShowAllData
    End With
  Next j
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
    .CutCopyMode = False
  End With
  On Error Resume Next
  Set OutEmail = Nothing
  Set OutApp = Nothing
End Sub

Sub Main2() 'Archive rows to Archive Sheet
Dim ws As Worksheet, aws As Worksheet, i As Long
  Dim j As Integer, calc As Integer
  Dim td As Date, r As Range, rr As Range
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With
  td = Date 'Today
Set aws = Worksheets("Archive")
  For j = 1 To aws.Index - 1
    Set ws = Worksheets(j)
    With ws
      If .AutoFilterMode = True Then .AutoFilterMode = False
      .UsedRange.AutoFilter 7, "<" & td
      Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
      Set r = Intersect(r, .Rows("2:" & .Rows.Count))
      If Not r Is Nothing Then
        r.Copy aws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        r.Delete xlUp
        .AutoFilter.ShowAllData
      End If
    End With
NextJ:
  Next j
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
    .CutCopyMode = False
  End With
End Sub

'signature, http://www.rondebruin.nl/win/s1/outlook/signature.htm
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
 
That's great thank you.

The spreadsheet edits and moves across to the other archive sheet when i run it.

The email still doesn't seem to work, however i'll put in the data and will try open it tomorrow and see if that works.

Thank you again for your help and expertise.
 
Added the code as above and added as module.

The data transfers perfectly to the archive if the date has elapsed. However, the email function is still not working.

Sorry to be a pain, but would you be able to have another look for me please?

Thank you in advance

Mike
 

Attachments

  • M_Sample-E-Test2.xlsm
    95.5 KB · Views: 7
It "worked" for me.

I noticed that I had left out the call to GetBoiler() but it still displayed the email.
Code:
sig = GetBoiler(sig)  'Get html text.

Of course once it runs, it updates column K's today's date by one.
 
Hi Kenneth,

I'm really unsure what is going on. The email still doesn't populate and the get boiler routine is flagging up as an error. I've tried different dates over different days to check, just in case the routine to stop it sending twice was stopping it.

The transfer of rows to archive seems to work perfectly.

sorry to be a pain, is there another way this could work, doesn't have to be HTML, plain text is ok.

Thank you again in advance

Mike
 
HTML is not the problem for Main1() Display/Send.

K2 date should be today, Ctrl+:. I did that in your post #12 file and fixed GetBoiler as detailed in post #13. It worked fine.

At this point, you may want to press F8 in Main1() to execute each line to see where it might be a problem for you. Of course if none of the sheets filter K column to today, then it won't "work".

You can easily test if the filter returns column K values of Today/Date:
Code:
Sub Test()
  Sheet3.UsedRange.AutoFilter 11, Date
End Sub

sig/Getboiler issue:
Press Win+E, type %AppData%, press Enter key, and navigate to Microsoft\Signatures. You should see your sig.htm and sig.rtf files there. The sig part is STD in my example. The actual sig variable will contain the full path to it. All you have to do is insert your basefilename for your signature file. There can be more than one in that folder.
 
Last edited:
Hi Kenneth,

I've done the test and it it give's a 'Run time error '1004':
AutoFilter method of range class failed.

This was done on a copy of my main spreadsheet and the cut and paste function wont work now either. It seems the filter is filtering the end date column, but not actually ticking the box for a date so no data shows which in turn i think causes the error.

This may also explain why the email is not populating as there filter will show no dates, even when today's date is there. using the F8 method as above, it does a loop through each worksheet but never goes on to the email information bit to allow it to do its bit.

Thank you again so much for your patience and help.
 
Sounds like your column data is not a Date value. Ctrl+1 lets view the number format quickly. Post a file with more than just the one example. Maybe do 4 or 5 rows.

I have seen some data where the date format was critical for a proper autofilter. I had to do the filter by a date string using Format().

My tests with 5 rows and 2 with today's date worked as expected.
 
I've tried again but still nothing. I've attached file in case I've changed something i shouldn't have.

The columns (G & K) were not in cell date format but now changed. The filter does filter, but doesn't show anything, even with today's date and prior dates until i un filter it back.

Thank you
 

Attachments

  • Test15Nov17.xlsm
    96.8 KB · Views: 4
As I thought, since you changed date format, Format() is needed. That format is probably different than your Regional settings. I know it is for me. I fixed GetBoiler() for you as well.

Be sure to test with backup limited data as I have not fully tested it. You will want to comment out .Display and uncomment .Send when it works as needed.

Code:
Sub Main1() 'Send emails for each row in each sheet where column K/11=Today
  Dim ws As Worksheet, aws As Worksheet, i As Long, j As Integer, calc As Integer
  Dim T$, CC$, td As Date, r As Range, rr As Range, sig$, htmSig$, rw As Range
  Dim subj$, bod$
  Dim OutApp As Object, OutEmail As Object
  'Tools > References > Microsoft Outlook xx.0 Object Library
'Dim OutApp As New Outlook.Application, OutEmail As Outlook.MailItem

'*********** Set Inputs *************************************************
  T = "ken@hotmail.co.uk"
  CC = ""
  htmSig = "std"
'*********** End Inputs *************************************************

  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With

  'signature, http://www.rondebruin.nl/win/s1/outlook/signature.htm
  sig = Environ("appdata") & "\Microsoft\Signatures\" & htmSig & ".htm"
  If Dir(sig) <> "" Then
    sig = GetBoiler(sig)  'Get html text.
Else: sig = ""
  End If
  td = Date 'Today
Set aws = Worksheets("Archive")
  Set OutApp = CreateObject("Outlook.Application")
  'With OutEmail
For j = 1 To aws.Index - 1
    Set ws = Worksheets(j)
    With ws
      If .AutoFilterMode = True Then .AutoFilterMode = False
      .UsedRange.AutoFilter 11, Format(td, "dd/mm/yyyy")
    Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
    For Each rr In r.Areas
      For Each rw In rr.Rows
          If rw.Row = 1 Then GoTo NextRW
          'Add a day, prevents another run today.
      rw.Cells(, 11).Value = rw.Cells(, 11).Value + 1
          subj = .Range("C1").Value & ":  " & rw.Cells(, 3).Value & " is due today."
          bod = .Range("C1").Value & ":  " & rw.Cells(, 3).Value & "<BR>"
          bod = bod & .Range("D1").Value & ":  " & rw.Cells(, 4).Value & "<BR>"
          bod = bod & "<BR>" & .Range("L1").Value & ":  " & rw.Cells(, 12).Value & "<BR>"
          bod = bod & sig
          Set OutEmail = OutApp.CreateItem(0)  '0=olMailItem
      With OutEmail
            .BodyFormat = 2 'olFormatHTML=2, not really needed.
        .Display
            'If range to html needed, http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
        .HTMLBody = bod
            .To = T
            .CC = CC
            .Subject = subj
            '.Send
        .Display
          End With
NextRW:
        Next rw
      Next rr
      .AutoFilter.ShowAllData
    End With
  Next j
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
    .CutCopyMode = False
  End With
  On Error Resume Next
  Set OutEmail = Nothing
  Set OutApp = Nothing
End Sub

Sub Main2() 'Archive rows to Archive Sheet
Dim ws As Worksheet, aws As Worksheet, i As Long
  Dim j As Integer, calc As Integer
  Dim td As Date, r As Range, rr As Range
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With
  td = Date 'Today
Set aws = Worksheets("Archive")
  For j = 1 To aws.Index - 1
    Set ws = Worksheets(j)
    With ws
      If .AutoFilterMode = True Then .AutoFilterMode = False
      .UsedRange.AutoFilter 7, "<" & Format(td, "dd/mm/yyyy")
      Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
      Set r = Intersect(r, .Rows("2:" & .Rows.Count))
      If Not r Is Nothing Then
        r.Copy aws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        r.Delete xlUp
        .AutoFilter.ShowAllData
      End If
    End With
NextJ:
  Next j
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
    .CutCopyMode = False
  End With
End Sub

'signature, http://www.rondebruin.nl/win/s1/outlook/signature.htm
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
Sub Test()
  Sheet3.UsedRange.AutoFilter 11, Format(Date, "dd/mm/yyyy")
End Sub
 
Hi Ken, I've put this spreadsheet in to practice over the past few weeks and seems to work brilliantly, so thank you for you help.

My Colleague, has added 2 further sheets (Key and Client List).

Would you be able to help again please?

i would like sheet 1 (Key) to be ignored and sheet 2 (Client list) to do the same as the others apart from getting the data from column A instead. I did have have a try which wasn't successful.

Thank you again in advance.
 

Attachments

  • Test15Nov17.xlsm
    93.7 KB · Views: 10
Since the last sheet is skipped by subtracting 1, we add one to the start of the loop to skip sheet 1. e.g.
Code:
For j = 2 To aws.Index - 1
As for sheet 2 (Client List), I don't know what you want. It only has two fields/columns A and K. Main1() uses more than just those two. It has no sample data to work with.

It may be more simple for sheet 2 to just use its own routine. You can call the 3 Subs, like:
Code:
Sub Main()
  Main1
  Main3
  Main2
End Sub
Or rename subs 3 if created to 2 and 2 to 3 so that Main() looks more logical.
 
Ken,

I've used this and has worked great. There is only 1 small issue that i hope you be able to help with.

If i run the macro and there is no data to be found. it will show an error and then not continue at this bit 'Run-Time error '1004' No Cells were found.
Code:
  Set r = .UsedRange.SpecialCells(xlCellTypeVisible)

Is there a code i could use to ignore or skip if there is no dates in range or send and email stating 'There is no updates for follow up today'.

Thank you again in advance
 
After that line:
Code:
If r is Nothing Then Goto NextJ
or, before loop
Code:
On Error Goto NextJ
At end of loop:
Code:
On Error Goto 0
 
I've added that but getting a Compile error label not defined. seems to be highlighting the Goto Nextj bit

I've tried a few variations but no luck.

Code:
For j = 3 To aws.Index - 1
If r Is Nothing Then GoTo NextJ
    Set ws = Worksheets(j)
    With ws
      If .AutoFilterMode = True Then .AutoFilterMode = False
      .UsedRange.AutoFilter 11, Format(td, "dd/mm/yyyy")
    Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
    For Each rr In r.Areas

and

Code:
For j = 3 To aws.Index - 1
On Error GoTo NextJ
    Set ws = Worksheets(j)
    With ws
      If .AutoFilterMode = True Then .AutoFilterMode = False
      .UsedRange.AutoFilter 11, Format(td, "dd/mm/yyyy")
    Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
    For Each rr In r.Areas

and

Code:
 Set r = .UsedRange.SpecialCells(xlCellTypeVisible)
    If r Is Nothing Then GoTo NextJ
 
Ken,

I sent that last message in haste as i have now added the 'NextJ:' in which has now made it all work perfectly.

Thank you so much for your assitance. i've learnt alot more about VBA from your help.

Kind regards

Code:
NextRW:
        Next rw
      Next rr
      .AutoFilter.ShowAllData
    End With
NextJ:
  Next j
  On Error GoTo 0
  With Application
 
Back
Top