Hi. This is the first real Macro that I have created. It seems to be working great except for when I try to update a user that Already exists in my spreadsheet. Basically here is how the Macro's work together(One from Excel and one from outlook). I have a rule set up in my outlook that will move emails with a certain title to one of my folders and then run a macro on that email. It goes through the email and opens one of my excel dosuments and inputs some data into. It then saves the excel file which activates the excel macro.

In the excel workbook I have two spreadsheets. On contains usernames in column A and empty cells for the other three columns that I want to update as these emails come in. The second spreadsheet contains the info from the outlook Macro. The Macro Works good except for when I try to update the three empty columns for an existing user. Both Macros are below:

Outlook Macro
Sub ExportToExcel(MyMail As MailItem)
    Dim strID As String, olNS As Outlook.NameSpace
    Dim olMail As Outlook.MailItem
    Dim strFileName As String

    'Excel Variables
    Dim XLApp As Object, XLwb As Object, XLws As Object
    Dim lRow As Long
    
    'Variable to extract text from body
     Dim MyAr() As String
    
    strID = MyMail.EntryID
    Set olNS = Application.GetNamespace("MAPI")
    Set olMail = olNS.GetItemFromID(strID)


        
        'Establish an EXCEL application object
         On Error Resume Next
         Set XLApp = GetObject(, "Excel.Application")

            'If not found then create new instance
            If Err.Number <> 0 Then
                Set XLApp = CreateObject("Excel.Application")
            End If
            Err.Clear
            On Error GoTo 0
                
        
        Set XLwb = XLApp.Workbooks.Open("Changed this for confidentiality")
     
             'Set the relevant output sheet. Change as applicable
        Set XLws = XLwb.Sheets("Outlook Data")
    
                 
       
    
        MyAr = Split(olMail.Body, vbCrLf)
    
        For i = LBound(MyAr) To LBound(MyAr)
       
        Debug.Print MyAr(i)
        Next i

   
        'Write to Excel
        XLws.Range("A2").Value = olMail.Subject
        XLws.Range("B2").Value = MyAr(10)
        XLws.Range("C2").Value = MyAr(0)
        XLws.Range("D2").Value = MyAr(4)
        
        'Close and Clean up Excel
        XLwb.Save
        XLwb.Close (True)
        XLApp.Quit
        
        Set XLws = Nothing
        Set XLwb = Nothing
        Set XLApp = Nothing
    
        Set olMail = Nothing
        Set olNS = Nothing
        
    End Sub
Excel Macro(the part that updates a current user on spreadsheet is highlighted)

Const xlUp As Long = -4162

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
    Dim lRow As Long
    Dim User As String
    Dim DateString As Date
    Dim ExtCode As Integer
    Dim rngFound As Range
    Dim Lookup As String
    Dim RangeF As String
    Dim rng As Range
          
    Sheets("Outlook Data").Select
   
   If Worksheets("Outlook Data").Cells(2, "B").Value <> "" Then
                       
    'format the data from sync email
    Cells.Replace What:="E-Mail sent on ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Exit Code: ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="User: ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    'Set the Data to variables
    Worksheets("Outlook Data").Select
    User = Cells(2, "B").Value
    DateString = Cells(2, "C").Value
    ExtCode = Cells(2, "D").Value
    
    'determine if the user already exists on the spreadsheet
    Sheets("Outlook Data").Cells(6, "B").FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(R[-4]C,'Sync Date'!R[-4]C[-1]:R[104]C[-1],1,FALSE)), 0,VLOOKUP(R[-4]C,'Sync Date'!R[-4]C[-1]:R[104]C[-1],1,FALSE))"
    Range("B6").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     
    Sheets("Outlook Data").Select
    Lookup = Cells(6, "B")
     
    'If user is not found adds the user and additional columns
   If Lookup = "0" Then
        Sheets("Sync Date").Select
        lRow = Sheets("Sync Date").Range("A" & Sheets("Sync Date").Rows.Count).End(xlUp).Row + 1
        Sheets("Sync Date").Range("A" & lRow).Value = User
        Sheets("Sync Date").Range("C" & lRow).Value = DateString
        Sheets("Sync Date").Range("D" & lRow).Value = ExtCode
    
        'determins Whether or not to update last succesful attempt
        Select Case ExtCode
        Case 0: Sheets("Sync Date").Range("B" & lRow).Value = DateString
        Case 10: Sheets("Sync Date").Range("B" & lRow).Value = DateString
        End Select

        'If the user is found it adds info to columns
        Else
               Sheets("Sync Date").Activate
          Set rng = ActiveSheet.Cells.Find(What:=User, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                                     :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                                     False, SearchFormat:=False)

        RangeF = rng.Row
        Sheets("Sync Date").Range("C" & RangeF).Value = DateString
        Sheets("Sync Date").Range("D" & RangeF).Value = ExtCode
        
        'Determines whether or not to update last succesful attempt
        Select Case ExtCode
        Case 0: Sheets("Sync Date").Range("B" & RangeF).Value = DateString
        Case 10: Sheets("Sync Date").Range("B" & RangeF).Value = DateString
        End Select   
 End If
    
    End If
End Sub
Let me know if you have any questions.

This is Outlook and Excel 2010 by the way.