Excel inventario

Nuevamente amigo mira lo que me dijeron es q tenia buscar a un experto que cambiara el codigo , lo q pasa q necesito ingresar mas de 500 productos
de hecho este es el codigo:
Sub INVENTARIO()
Dim CATEGORIA As String
Dim DESCRIPCION As String
Dim CANTIDAD As Integer
Dim CONTROLB As String
If Range("B6").Value = Empty Or _
    Range("E6").Value = Empty Or _
    Range("F6").Value = Empty Then
    MsgBox "Favor de completar los datos", vbOKOnly + vbInformation, "**Información incompleta"
Exit Sub
End If
'Le damos valores a las variables
ID = Range("B6").Value
CATEGORIA = Range("C6").Value
DESCRIPCION = Range("D6").Value
CANTIDAD = Range("E6").Value
CONTROLB = Range("F6").Value
Sheets("INVENTARIO").Select
Range("A:A").Select
For x = 1 To 20
    Selection.Find(What:=ID, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    similar = Len(ActiveCell.Text)
    If Len(ID) = similar Then
        ActiveCell.Select
Exit For
    End If
Next x
If ActiveCell.Value = ID And CONTROLB = "ENTRADA" Then
    ActiveCell.Offset(0, 3).Select
    bodegaanterior = ActiveCell.Value
    bodeganueva = Val(ActiveCell.Value) + Val(CANTIDAD)
    ActiveCell.Value = bodeganueva
    Selection.End(xlToLeft).Select
    MsgBox "Se agregaron " & CANTIDAD & " " & DESCRIPCION & " a bodega." & Chr(13) & "Aumentó de: " & bodegaanterior & " a " & bodeganueva & " artículos.", vbOKOnly + vbInformation, "**Entradas"
    Sheets("HISTORIAL").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = ID
    ActiveCell.Offset(0, 1).Value = CATEGORIA
    ActiveCell.Offset(0, 2).Value = DESCRIPCION
    ActiveCell.Offset(0, 3).Value = CANTIDAD
    ActiveCell.Offset(0, 4).Value = CONTROLB
    fecha = Now()
    ActiveCell.Offset(0, 5).Value = fecha
    MsgBox "Registro exitoso en historial", vbOKOnly + vbInformation, "**Historial"
    Sheets("PRINCIPAL").Select
    Range("B6,E6,F6").ClearContents
    Range("A1").Select
End If
If ActiveCell.Value = ID And CONTROLB = "SALIDA" Then
    ActiveCell.Offset(0, 3).Select
    bodegaanterior = ActiveCell.Value
        If bodegaanterior < CANTIDAD Then
            MsgBox "No hay artículos suficientes" & Chr(13) & "Sólo hay " & bodegaanterior & " artículos en bodega.", vbOKOnly + vbCritical, "**Información de bodega"
            Sheets("PRINCIPAL").Select
        Exit Sub
        End If
    bodeganueva = Val(ActiveCell.Value) - Val(CANTIDAD)
    ActiveCell.Value = bodeganueva
    Selection.End(xlToLeft).Select
    MsgBox "Salieron " & CANTIDAD & " " & DESCRIPCION & " de bodega." & Chr(13) & "Disminuyó de: " & bodegaanterior & " a " & bodeganueva & " artículos.", vbOKOnly + vbInformation, "**Salidas"
    Sheets("HISTORIAL").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = ID
    ActiveCell.Offset(0, 1).Value = CATEGORIA
    ActiveCell.Offset(0, 2).Value = DESCRIPCION
    ActiveCell.Offset(0, 3).Value = CANTIDAD
    ActiveCell.Offset(0, 4).Value = CONTROLB
    fecha = Now()
    ActiveCell.Offset(0, 5).Value = fecha
    MsgBox "Registro exitoso en historial", vbOKOnly + vbInformation, "**Historial"
    Sheets("PRINCIPAL").Select
    Range("B6,E6,F6").ClearContents
    Range("A1").Select
End If
End Sub
muchas gracias