Dim rng As Range
Dim olApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Dim cell As Range
Dim countE As Integer
Dim start As Range
Dim finish As Range
Dim movetomanger As Outlook.MAPIFolder
Dim countM As Integer
Dim rngarry As Variant
Dim emcount, casecount, movedcount, itm
Set rng = Range(Range("A2"), Range("A2").End(xlDown))
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.Folders("Documents").Folders("Inbox")

Set movetomanger = olFolder.Folders("......Managers").Folders(".managersname")

Set finish = ThisWorkbook.Sheets("Mover").Range("I11")
Set start = ThisWorkbook.Sheets("Mover").Range("I10")
start.Value = Format(Now, "hh:mm:ss")

Set emcount = Range("I12")
Set casecount = Range("I13")
Set movedcount = Range("I14")
    OptimizeCode_Begin
countM = 0
countE = 0

rngarry = Range("a2:A241").Value


For Each msg In olFolder.Items
    For Each itm In rngarry
    If (itm = msg.EntryID) Then
    msg.UnRead = True

msg.move managersname
    countM = 1 + countM

    End If
     Next
     countE = 1 + countE
Next






finish.Value = Format(Now, "hh:mm:ss")
OptimizeCode_End
emcount.Value = countE
casecount.Value = rng.count
movedcount.Value = countM


End Sub