Speed Up VBA Loop Code

I have the following code which runs through over 140K records and makes changes base on the code below. Currently, it is taking 20to 30 min to run this simple macro. Is there any way to speed up the code below to cut down the processing time?Thanks

 Dim H As Range, I As Range, dd As Range
Set I = Range("E:E")
For Each dd In I.Cells
    If dd.Value = "1" Then dd = "A"
Next dd

For Each dd In I.Cells
  If dd.Value = "2" Then dd = "B"
Next dd

For Each dd In I.Cells
    If dd.Value = "3" Then dd = "C"
Next dd

For Each dd In I.Cells
    If dd.Value = "4" Then dd = "D"
Next dd

For Each dd In I.Cells
    If dd.Value = "5" Then dd = "E"
Next dd

changing the

Set I = Range("E:E")

into

Set I = Range("E1:E1000")

I got compile error: Elseif without If. Thanks

Turn off automatic calculations and screen updating and bunch all in one loop...

Try the macro attached

Thank You jolivanes. That worked perfectly!

Try this on a copy of your workbook

Sub Replace_With_An_Array()
  Dim Rng As Range
  Dim What As Variant
  Dim Repl  As Variant
  Dim i As Long
    What = Array(1, 2, 3, 4, 5)
    Repl = Array("A", "B", "C", "D", "E")
    For i = 0 To UBound(What)
        Set Rng = ActiveSheet.Range("E2", Range("E" & Rows.Count).End(xlUp))
        Rng.Replace What:=What(i), Replacement:=Repl(i), MatchCase:=False
    Next i
End Sub

The 1,2,3,4,5 and the A,b,c,d,e were samples. I actually have anumber like 401, 402,403,404,405 and then 402=Apple, 403=Orange etc. How could I alter your transform code to factor this in? Thanks

Sorry! Please see corrected code post 2

Just because I had some spare time!!!!!
On 518,400 cells on my older XP machine:

6.23 seconds

Sub Replace_With_An_Array()
  Dim Rng As Range
  Dim What As Variant
  Dim Repl  As Variant
  Dim t
  Dim x
  Dim i As Long
  t = Timer
  Application.ScreenUpdating = False
    What = Array(1, 2, 3, 4, 5)
    Repl = Array("A", "B", "C", "D", "E")
    For i = 0 To UBound(What)
        Set Rng = ActiveSheet.Range("E2", Range("E" & Rows.Count).End(xlUp))
        Rng.Replace What:=What(i), replacement:=Repl(i), MatchCase:=False
    Next i
Application.ScreenUpdating = True
MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub

6.22 seconds

Sub Maybe_This_A()
    Dim r As Range
  Dim t
  Dim x
  t = Timer
    Application.ScreenUpdating = False
    Set r = ActiveSheet.Range("E2", Range("E" & Rows.Count).End(xlUp))
    r.Replace What:=1, lookat:=xlPart, replacement:="A"
    r.Replace What:=2, lookat:=xlPart, replacement:="B"
    r.Replace What:=3, lookat:=xlPart, replacement:="C"
    r.Replace What:=4, lookat:=xlPart, replacement:="D"
    r.Replace What:=5, lookat:=xlPart, replacement:="E"
    Application.ScreenUpdating = True
    MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub

16.39 seconds

Sub Replace_Some()
Dim c As Range
  Dim t
  Dim x
  t = Timer
Application.ScreenUpdating = False
For Each c In Range("E2", Range("E" & Rows.Count).End(xlUp))
If c.Value = 1 Then
c.Value = "A"
ElseIf c.Value = 2 Then c.Value = "B"
ElseIf c.Value = 3 Then c.Value = "C"
ElseIf c.Value = 4 Then c.Value = "D"
ElseIf c.Value = 5 Then c.Value = "E"
End If
Next c
Application.ScreenUpdating = True
MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub

6.28 seconds

Sub tgr()
  Dim t
  Dim x
  t = Timer
  Application.ScreenUpdating = False
    With Intersect(ActiveSheet.UsedRange, Columns("E"))
        .Replace "1", "A"
        .Replace "2", "B"
        .Replace "3", "C"
        .Replace "4", "D"
        .Replace "5", "E"
    End With
    Application.ScreenUpdating = True
    MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub

Hi Richard.
I more or less thought that your suggestion and the 2nd code would be the same. Unless the "lookat:=xlPart" makes a difference.
I did change the code to be without the xlPart but it did not make any difference on my machine.
I have cells numbered from 1 to 9 in Column E and repeat this to a total of 518,400 cells (E2:E518401)

Goedemorgen (Good Morning) Olaf
I did as you suggested but it did not take any time off the clock.
However, I think you're right that it is useless to set the rng every time.

I have attached the file so anyone can play with it on their own machine.
Please read the comments on Sheet1 in the red bordered box first. This was done to keep the file small.

Happy, Healthy and Prosperous 2013.

John

Hi Richard
That is a considerable difference, 15.7 vs 41.5 seconds. My computer is about 6-7 years old so definitely not the latest screaming fast machine.
Happy, Healthy and Prosperous 2013 to you and yours.

John