1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Auto Update Multiple Sheets and Outlook Calendar w/o Duplicates

Discussion in 'Business Applications' started by Lil Help, Jul 31, 2008.

Thread Status:
Not open for further replies.
  1. Lil Help

    Lil Help Thread Starter

    Joined:
    Jul 31, 2008
    Messages:
    4
    I just started working with Macros in Excel on Monday. I've been figuring out what I need to do, searching for threads/blocks and adapting them to my needs. However, since I don't know the basics, I frequently come to dead ends. I apologize for my ignorance, but I have to start somewhere and I need to get this project finished. I have a few parts, and I've included code that I've put together/adapted adjacent to my explination.


    I have a workbook with a series of worksheets
    The first sheet is a Job List and the list has columns for each type of permit that can be selected for each job.
    The idea would be to put an X or some indicator in a column if a certain permit is necessary for the job associated with that row.
    Each subsequent sheet is one of the types of permits.
    Some jobs need multiple permits.
    I would like a macro that, whenever anyone adds a job, it automatically updates the necessary worksheets with the job name.
    So if Job Blue needs Permit X and Permit Y, the macro will only add the Job Name “Blue” to worksheets X and Y but not Z.

    Or

    I've created a formula that recognizes if a cell on the job list sheet has been marked and takes the job name from column A. A macro that could recognize when the formula changes results and subsequently autofills the formula underneath the last cell would also work. I've included what I have been putting together.

    I have the following, however the line indicated doesn't work:
    Code:
    [/SIZE][/FONT]
    [FONT=Times New Roman][SIZE=3]Private Sub Worksheet_Change(ByVal Target As Range)[/SIZE][/FONT]
    [FONT=Times New Roman][SIZE=3]        Dim Joblistrange() As Variant, i As Long
            'When the Job List Sheet has a new job added, the Range changes
            'Which triggers the next macro
            [/SIZE][/FONT]
    [FONT=Times New Roman][SIZE=3]'The following line is bugging "91 Object variable or block variable not set"
             Joblistrange = Sheet2.Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value
                 On Error Resume Next
             If "$joblistrange" Then
              On Error Resume Next
              
              'Declare range Variables
                Dim selection1 As Range
                Dim selection2 As Range[/SIZE][/FONT]
    [FONT=Times New Roman][SIZE=3]                'Set range variables = their respective ranges
                    Set selection1 = Sheet3.Range(LASTCELL - 1)
                    Set selection2 = Sheet3.Range(LASTCELL)
                    'Autofill
                    selection1.AutoFill Destination:=selection2
                    
                    
              If Err.Number <> 0 Then
                MsgBox Err.Number & " " & Err.Description
                Err.Clear
              End If
             End If
             On Error GoTo 0
          End Sub[/SIZE][/FONT]
    [FONT=Times New Roman][SIZE=3]



    I also tried adapting all this as an alternative:
    Code:
    [/SIZE][/FONT]
    [FONT=Times New Roman][SIZE=3]Option Explicit
     'Create variable to hold values
    Dim Monitored
     
    Private Sub Worksheet_Activate()
        Monitored = Sheet2.Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value 'Read in value prior to any changes
             On Error Resume Next
    End Sub
     
    Private Sub Worksheet_Change(ByVal Target As Range)
         'Check target to determine if macro is triggered
        If Intersect(Sheet2.Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value) Is Nothing Then Exit Sub
         'Prevent looping of code due to worksheet changes
        Application.EnableEvents = False
         'Compare monitored cell with initial value
        If Range(Sheet2.Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value).Value <> Monitored Then
             'Do things as a result of a change
            DoThings
             'Reset Variable with new monitored value
            Monitored = Range(Sheet2.Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value).Value
        End If
         'Reset events
        Application.EnableEvents = True
    End Sub
     
    Private Sub DoThings()
        With Range("E9")
            .Formula = Range("E6") + Range("E7")
            If .Interior.ColorIndex = 6 Then
                .Interior.ColorIndex = 8
            Else: .Interior.ColorIndex = 6
            End If
        End With
    End Sub[/SIZE][/FONT]
    [FONT=Times New Roman][SIZE=3]

    However I can't figure out how to adapt it properly.

    There is also an Expirations worksheet which will not apply to the above.

    THEN

    The last worksheet is the Expiration Dates
    Each prior worksheet will have the job name and when the date a permit was received. The Expiration worksheet has columns for job name, permit type, date permit received, and will calculate when they expire.
    I need a macro that will go through each of the permit sheets and update the expirations sheet with the job name, the type of permit and the date the permit was received. I would like it if when the permit date received is input, the expiration page is updated.
    Since some jobs need multiple permits, there will be multiple rows in the expirations page with the same job name, the type of permit is the differing factor.

    THEN

    I have put together a macro to update the outlook calendar (2003) as per the expirations page.
    The expiration page calculates the proper amount of time needed for the renewal process.
    The macro creates an appointment on the outlook calendar that alerts the user that a permit will expire, and it will do so in the amount of time that is needed for the renewal process.
    As I have it now, if I were to add a job to the expirations page and run the macro everything is fine. However, if I add a job and run the macro again, all the previous jobs that already have dates on the calendar would be added again, i.e. multiple appointments for the same job permit. What would the code block be to check the calendar if an appointment already exisits and not create a new appointment, or to delete all previous appointments with a certain name?
    Also, if there is a way to set the appointment to remind after 2 weeks that would be very nice but not necessary at all.

    Code:
     
    [COLOR=navy][FONT=Arial]Sub ExportAppointmentsToOutlook()[/FONT][/COLOR]
    [COLOR=navy][FONT=Arial]    Dim olApp As Outlook.Application
        Dim olApt As AppointmentItem
        Dim blnCreated As Boolean
        
        Application.ScreenUpdating = False
        
    'Read the table with appointments:
        Dim arrAppt() As Variant, i As Long
        arrAppt = Range("A2", Cells(Rows.Count, "E").End(xlUp)).Value
        On Error Resume Next
        Set olApp = GetObject(, "Outlook.Application")
        If olApp Is Nothing Then
            Set olApp = CreateObject("Outlook.Application")
            blnCreated = True
            Err.Clear
        Else
            blnCreated = False
        End If
        On Error GoTo 0[/FONT][/COLOR]
    [COLOR=navy][FONT=Arial]'Create the outlook item for the table entries:
    'Rows:
    ' Column A = Job Name
    ' Column B = Permit Type
    ' Column C = Date Received
    ' Column D = Renewal Process
    ' Column E = Expiration Date[/FONT][/COLOR]
    [COLOR=navy][FONT=Arial]    For i = LBound(arrAppt) To UBound(arrAppt)
        
        
            Set olApt = olApp.CreateItem(olAppointmentItem)
            
            With olApt
                .Start = arrAppt(i, 4)
                .End = arrAppt(i, 4)
                .AllDayEvent = True
                .Subject = arrAppt(i, 1) & " Permit Expiration Approaching"
                .Location = arrAppt(i, 1)
                .Body = arrAppt(i, 2) & " permit expires " & arrAppt(i, 5) & ".  Please begin the renewal process. Do you need a new water sample? Don't forget the letter from the owner. - Created by excel tool"
                .BusyStatus = olBusy
                .ReminderSet = True
                .ReminderMinutesBeforeStart = 0
                .Save
            End With
        Else
        Next i
       [/FONT][/COLOR]
    [COLOR=navy][FONT=Arial]    Set olApt = Nothing
        Set olApp = Nothing[/FONT][/COLOR]
    [COLOR=navy][FONT=Arial]    Application.ScreenUpdating = True[/FONT][/COLOR]
    [COLOR=navy][FONT=Arial]End Sub[/FONT][/COLOR]
    [COLOR=navy][FONT=Arial][/FONT][/COLOR] 
    



    Thank you very much for any and all help.
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/735651

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice