none
Skipping or ignoring blank cells or cells that have text

    Question

  • Hi I've only used VBA a few times and I've always copied and pasted from the interent to get what I need. I'm stuck on skipping blanks cells or cells that don't have a value. This macro is just for an email alert when the due date is approaching. There are blank rows and possible text that could be in the column along with the dates. I do not need to do anything with the cells that are blank or have no value. Right now I'm getting 4K emails and I only need emails on the cells that the dates hit within 30 days.

    Thanks, Bob

    What I have so far

    Set Rng = .Range("I11", .Cells(.Rows.Count, 1).End(xlUp))
    End With

    For Each rngCell In Rng
     
    If rngCell.Offset(91, 0) > Evaluate("B2 +30") Then Exit Sub

    If rngCell.Offset(91, 0) <= Evaluate("B2 +30") Then
    Call Mail_small_Text_Outlook

    End If

    Thursday, December 19, 2013 6:19 PM

Answers

  • Thanks again but I got a Compile error: Expected End Sub

    I recommend that you work through a beginner tutorial, here is one:

    http://www.wiseowl.co.uk/blog/s161/online-excel-vba-training.htm

    Andreas.

    Sub Calibration()
      Dim rngCell As Range
      For Each rngCell In Range("I11:I91")
        If rngCell <= Range("B2") + 30 Then
          If rngCell >= Range("B2") - 30 Then
            Call Mail_small_Text_Outlook
          End If
        End If
      Next
    End Sub

    Sub Mail_small_Text_Outlook()
      Dim OutApp As Object
      Dim OutMail As Object
      Dim strbody As String

      Set OutApp = CreateObject("Outlook.Application")
      Set OutMail = OutApp.CreateItem(0)

      strbody = "Calibration is due! " & _
        " Time to schedule!" & _
        " GO TO CALIBRATION RECORD.XLSX"

      With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Measuring Equipment Calibration Due"
        .Body = strbody
        .Display
      End With
    End Sub

    Saturday, December 21, 2013 9:25 AM

All replies

  •   For Each rngCell In Rng
        If rngCell.Offset(91, 0) <= Range("B2") + 30 Then
          If rngCell.Offset(91, 0) >= Range("B2") - 30 Then
            Call Mail_small_Text_Outlook
          End If
        End If
      Next

    I assume that cell B2 and rngCell.Offset(91, 0) contains a date.

    Andreas.

    Friday, December 20, 2013 8:09 AM
  • Andreas thanks for the reply. Thanks for your patience, this is my first time using any forum ever so I guess I'm not asking the correct question either. For the first time I wasn't able to get code from the internet and make a couple tweaks to make it work. As I read more on VBA I was close to the code I needed but not close enough. B2 is today's date with =TODAY(). Column I starting at I11 to I91 are calibration due dates with a couple rows that are blank seperating the different measuring tools. What I'm doing is comparing TODAY with the CALIBRATION DATES to see if it is within 30 days. If within 30 days of today's date then excel is to send an email alert to the correct person. Once I get the macro to work correctly I was going to set up Windows Task Scheduler to run the macro on a weekly basis.

    I now believe rngCell.Offset was the wrong thing to use in my appliction. I got rid of the issue of thousands of emails by removing Next rngCell with just Next. Again grabbed code from someone else without knowing what their spreadsheet looked like. I think this is closer but it doesn't work quite right.

    Set Rng = .Range("I11:I91")
     End With

     For Each c In Rng
     If c.Value > (B2 + 30) Then Exit Sub
     
     If c.Value <= (B2 + 30) Then
     Call Mail_small_Text_Outlook

    End If

    Next

    End Sub

    Friday, December 20, 2013 4:50 PM
  • I got rid of the issue of thousands of emails by removing Next rngCell with just Next.

    That is not the reason, the argument behind NEXT is ignored by the compiler in VBA. Change the code like shown below.

    Andreas.

      For Each rngCell In Range("I11:I91")
        If rngCell <= Range("B2") + 30 Then
          If rngCell >= Range("B2") - 30 Then
            Call Mail_small_Text_Outlook
          End If
        End If
      Next

    Friday, December 20, 2013 5:45 PM
  • Thanks again but I got a Compile error: Expected End Sub

    Also I don't need an email sent if the calibration date is over 30 days from today's date (B2) only within 30 days. The macro could just end I think.

    Sub Calibration()
     With ActiveSheet
     
     For Each rngCell In Range("I11:I91")
      If rngCell <= Range("B2") + 30 Then
       If rngCell >= Range("B2") - 30 Then
        Call Mail_small_Text_Outlook
       End If
      End If
     Next

    Sub Mail_small_Text_Outlook()
     Dim OutApp As Object
     Dim OutMail As Object
     Dim strbody As String
     
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)
     
     strbody = "Calibration is due! " & " Time to schedule!" & " GO TO CALIBRATION RECORD.XLSX"

     On Error Resume Next
     With OutMail
     .To = ""
     .CC = ""
     .BCC = ""
     .Subject = "Measuring Equipment Calibration Due"
     .Body = strbody

     .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

    End Sub

    Friday, December 20, 2013 7:16 PM
  • Thanks again but I got a Compile error: Expected End Sub

    I recommend that you work through a beginner tutorial, here is one:

    http://www.wiseowl.co.uk/blog/s161/online-excel-vba-training.htm

    Andreas.

    Sub Calibration()
      Dim rngCell As Range
      For Each rngCell In Range("I11:I91")
        If rngCell <= Range("B2") + 30 Then
          If rngCell >= Range("B2") - 30 Then
            Call Mail_small_Text_Outlook
          End If
        End If
      Next
    End Sub

    Sub Mail_small_Text_Outlook()
      Dim OutApp As Object
      Dim OutMail As Object
      Dim strbody As String

      Set OutApp = CreateObject("Outlook.Application")
      Set OutMail = OutApp.CreateItem(0)

      strbody = "Calibration is due! " & _
        " Time to schedule!" & _
        " GO TO CALIBRATION RECORD.XLSX"

      With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Measuring Equipment Calibration Due"
        .Body = strbody
        .Display
      End With
    End Sub

    Saturday, December 21, 2013 9:25 AM
  • Andreas, thanks for everything. I will check out the tutorials because this very new to me and I think it is very cool stuff. I reached out to a professional and this is the code he recommended. Works perfectly, had to take out the blank spaces in the excel spreadsheet.


    Dim objExcel
    Dim objOutlook
    Dim objMail
    Dim objWB
    Dim objWS
    Dim vCell

    Set objExcel = CreateObject("Excel.Application")
    Set objOutlook = CreateObject("Outlook.Application")

    objExcel.DisplayAlerts = False
    objExcel.Workbooks.Open ("")
    Set objWB = objExcel.Activeworkbook
    Set objWS = objWB.ActiveSheet
    For Each vCell In objWS.Range("I11:I85")

    If FormatDateTime(vCell-30) <= FormatDateTime(Date) Then
    Set objMail = objOutlook.CreateItem(olMailItem)

    objMail.To = ""
    objMail.Subject = vCell.offset(0, -7).Value & " Email Alert"

    objMail.Body = "Item - " & vCell.offset(0, -7).Value & vbCrLf & _
    "Requires Calibration by " & vCell.offset(0, 0).Value & vbCrLf & _
    ""

    objMail.Send
    End If
    Next


    objWB.Save
    objWB.Close
    objExcel.Quit
    Set objExcel = Nothing
    Set objWB = Nothing
    Set objWS = Nothing
    Set objMail = Nothing
    Set objOutlook = Nothing

    Monday, December 23, 2013 1:54 PM