Microsoft Excel - VBA Macro help Please - Asked By Stephen P on 15-Mar-13 09:51 AM

I have the code listed later in this post. I am trying to incorporate within the for next loop to look if column J is blank and column k is not blank(if both criteria are met then it sets up an appointment in outlook then loops, if not then it simply loops and goes to the next row.The code I currently am using to try to accomplish this is in bold. If you try to run this code, it will not work unless the workbook is set up the way I have it set up, as their are references to other data from separate sheets. Thank you in advance.

Sub CreateAppointment()
Dim WS As Worksheet
Dim LastCellA As Range, LastCellB As Range
Dim LastCellRowNumber As Long
Workbooks("!      ! Template for Scheduling DataV2.xlsm").Activate

Set WS = Worksheets("DATA")
With WS
    Set LastCellA = .Cells(.Rows.Count, "A").End(xlUp)
    'Set LastCellB = .Cells(.Rows.Count, "B").End(xlUp)
    LastCellRowNumber = Application.WorksheetFunction.Max(LastCellA.Row)
End With
WS.Select


   Dim myOlApp As Outlook.Application
   Dim myItem As Outlook.AppointmentItem
'find last row with information in column
For finalcell = 2 To LastCellRowNumber
'For finalcell = 2 To LastCellRowNumber

Set LastCellB = Range("C" & finalcell)

If Len(LastCellB) > 0 Then LastCellB = UCase(LastCellB)

If Range("J" & finalcell).Value = "" And Range("K" & finalcell).Value <> "" Then GoTo 5

'If Sheets("DATA").Range("Q" & finalcell) = "Scheduled" Then GoTo 5

'If Sheets("DATA").Range("Q" & finalcell) = "Scheduled" Then finalcell = (finalcell + 1) Else

Range("B" & finalcell).Formula = "=IFERROR(HLOOKUP(C" & finalcell & ",HUBS,2,FALSE),)"
Range("B" & finalcell).Select
With Selection
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Range("U" & finalcell).Formula = "=VLOOKUP(O" & finalcell & ",'Email List'!A$1:B$400,2,FALSE)"
Range("U" & finalcell).Select
With Selection
.Copy
.PasteSpecial Paste:=xlPasteValues
'Range("Q" & finalcell).Value = "Scheduled"
'Range("J" & finalcell).Value = "Invitation Sent"

End With

  Set myOlApp = GetObject(, "Outlook.Application")
  Set myItem = myOlApp.CreateItem(olAppointmentItem)
  'Dim objectfiller As String
  'objectfiller = Sheets("DATA").Range
  With myItem
   .Subject = "CHG " & Sheets("DATA").Range("k" & finalcell) & " " & Sheets("DATA").Range("B" & finalcell) & " " & Sheets("DATA").Range("C" & finalcell) & " " & Sheets("DATA").Range("F" & finalcell) & " "
  .Location = Sheets("DATA").Range("b" & finalcell) & " " & Range("C" & finalcell)
   .Start = Sheets("DATA").Range("A" & finalcell)
      ''.Duration = Sheets("DATA").Range("d4")
  
   .End = Sheets("DATA").Range("T" & finalcell)
      ''.ForwardAsVcal = sheeets("DATA").Range("t" & finalcell)
  .Body = "Project Owner " & Sheets("DATA").Range("M" & finalcell) & Chr(10) & "CHG " & Sheets("DATA").Range("k" & finalcell) & Chr(10) & "TSK " & Sheets("DATA").Range("l" & finalcell) & Chr(10) & Sheets("DATA").Range("B" & finalcell) & Chr(10) & "Hub " & Sheets("DATA").Range("C" & finalcell) & Chr(10) & Sheets("DATA").Range("F" & finalcell) & " " & Chr(10) & "MOP: " & Sheets("DATA").Range("N" & finalcell)
  
  .RequiredAttendees = Sheets("DATA").Range("u" & finalcell)
      '' .Recipients = Sheets("DATA").Range("u" & finalcell)
  
   .Send
   .Save
  Range("Q" & finalcell).Value = "Scheduled"
Range("J" & finalcell).Value = "Invitation Sent   "
   End With

5
   Next finalcell
   ActiveWorkbook.Save

   '   Sub Mail_Workbook_1()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
ActiveWorkbook.SaveAs Filename:="Work Status Dated " & Format(Date, "MM.DD.YYYY ") & Format(Time, "hh.mm") & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
'ActiveWorkbook.SaveAs Filename:="!      ! Template for Scheduling DataV2.xlsm", FileFormat:=52, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

'Workbooks("!      ! Template for Scheduling DataV2.xlsm").Activate
Dim this_thur
this_thur = Now() - Weekday(Now()) + 5 + (Weekday(Now()) > 5) * 7
If today = this_thur Then GoTo 10
   
    Dim OutApp As Object
    Dim OutMail As Object

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

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
    .To = "stephen.pannunzio@gmail.com"
    .CC = ""
    .BCC = ""
    .Subject = "Work Status Summary Report " & Now()
    .Body = Chr(10) & "Report generated by Stephen Pannunzio." & Chr(10) & "Generated on " & Now() & Chr(10) & "Located P:\Eng\Network Planning\!2013 MOPS"
   
    .Attachments.Add Workbooks("Work Status Dated " & Format(Date, "MM.DD.YYYY ") & Format(Time, "hh.mm") & ".xls").FullName
    ' You can add other files by uncommenting the following line.
    '.Attachments.Add ("C:\test.txt")
    ' In place of the following statement, you can use ".Display" to
    ' display the mail.
    .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
10

ActiveWorkbook.SaveAs Filename:="!      ! Template for Scheduling DataV2" & ".xlsm", FileFormat:=52, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

End Sub

Robbe Morris replied to Stephen P on 15-Mar-13 10:00 AM
You may want to try trimming the value before comparing it to an empty string.  Also, are these numeric types?  You may want to put in some Debug statements to make sure that .Value contains what you think it should contain.

That said, your IF statement, if true, would goto 5 and move onto the next record.  The following statement seems to indicate you want it to do the exact opposite of the code your wrote.

"for next loop to look if column J is blank and column k is not blank(if both criteria are met then it sets up an appointment in outlook then loops,"

You say that it should set up the appoint if J is blank but K is not.  Your code says the opposite, skips the appointment setting, and moves onto the next record.  That is, of course, unless I missed something while reading your code.
Stephen P replied to Robbe Morris on 15-Mar-13 10:10 AM
thanks for the response,
I have been looking at it so long, I needed a fresh set of eyes.
going to go back and review now.
Not sure what you meant by trimming the value k sometimes has numeric, J is never numeric, I had tried making sure.value was not 0 and also tried len <>0 neither worked. which is why I am asking for help.
Robbe Morris replied to Stephen P on 15-Mar-13 10:17 AM
If someone puts an empty space in your cell, it won't equal "" it will equal " ".  They are not the same.  The Trim function gets rid of leading and ending spaces.  If (Trim(Range("J" & row).Value) = "") blah blah blah

http://www.techonthenet.com/excel/formulas/trim.php
Stephen P replied to Robbe Morris on 15-Mar-13 10:22 AM
I appreciate the trim input, although I am the only person who should be inputting data, but as you said,  I will not see a space if it is inadvertently or intentionally input.
Looking over code now, I think I understand what you were saying with the goto5 reference, seems to go to next ulimately, still reviewing
Robbe Morris replied to Stephen P on 15-Mar-13 10:47 AM
Based on what you said it should do, I think the code would be the following.  This says that is either condition isn't met, skip to the next row.


If Trim(Range("J" & finalcell).Value <> "") OR Trim(Range("K" & finalcell).Value = "") Then GoTo 5
Stephen P replied to Robbe Morris on 15-Mar-13 11:12 AM
Very Accurate Robbe Morris, this was precisely what I was looking for, Much appreciated.