Visual Basic para Aplicaciones - Ayuda por favor!!!

Tengo un gran problema! tenia un archivo excel que lo que hacia era comparar dos listas de calles para "normalizar" y que no se dupliquen los datos.
dejo de andar de un dia para el otro :S
Y me tira un error que no lo puedo solucionar :S!!!

Aca esta la cadena:

Public LibroExt As Workbook
Public hoja As Worksheet
Public LibroCal As Workbook
Public Col As Single
Public ColA As Single
Public nom() As String
Public Celda As String
Public ren As Integer
Public CalleNO As String

Public Sub Main() ACTUALMENTE ESTO ME LO MARCA EN AMARILLO
Dim LibroExtS As String
Dim UserRangeCalle As Range
Dim UserRangeAltura As Range

Set LibroCal = ThisWorkbook

On Error GoTo DIALOG_ERROR

With FrmInicio.DialOpen ANTES ME MARCABA ACA EN AMARILLO
.CancelError = True
.Filter = "Excel Files (*.xls)|*.xls|"
.FilterIndex = 1
.DialogTitle = "Planilla Excel a Modificar"
.ShowOpen
LibroExtS = .Filename
End With

Set LibroExt = Workbooks.Open(LibroExtS, 3, False, , , , , , , , True)
LibroExt.Activate

If LibroExt.ReadOnly Then
MsgBox ("La planilla es 'SOLO LECTURA'. ")
Exit Sub
End If

For Each h In Worksheets
If (h.Name = "Hoja Modificada") Then
Application.DisplayAlerts = False
h.Delete
End If
Next h

Set UserRangeCalle = Application.InputBox("Seleccione la columna de CALLES", CALLES, LibroExt.ActiveSheet.Columns(1).Address, Type:=8)
Set UserRangeAltura = Application.InputBox("Seleccione la columna de ALTURAS", ALTURAS, UserRangeCalle.Offset(0, 1).Address, Type:=8)
Col = UserRangeCalle.Column
ColA = UserRangeAltura.Column

UserRangeCalle.Worksheet.Copy After:=UserRangeCalle.Worksheet
Set hoja = ActiveSheet
With hoja
.Name = "Hoja Modificada"
.Columns(Col + 1).EntireColumn.Insert Shift:=xlShiftToRight
.Cells(1, Col + 1).Value = "CALLE OFICIAL"
.Columns(Col + 1).ColumnWidth = 33
.Cells(1, Col + 1).Font.Size = 12
.Cells(1, Col + 1).Font.Bold = True
.Cells(Col + 1).HorizontalAlignment = xlLeft
.Columns(ColA + 2).EntireColumn.Insert Shift:=xlShiftToRight
.Cells(1, ColA + 2).Value = "DIRECCION"
.Columns(ColA + 2).ColumnWidth = 50
.Cells(1, ColA + 2).Font.Size = 12
.Cells(1, ColA + 2).Font.Bold = True
.Cells(ColA + 2).HorizontalAlignment = xlLeft
End With

ChequearCal

Exit Sub

DIALOG_ERROR:
Err.Raise Err.Number, Err.Source, Err.Description
Exit Sub
End Sub
Public Sub ChequearCal()
exacto = False
coincide = False
ren = 2
i = 2
p = False
Set CalleActual = hoja.Cells(ren, Col)
Do While Not IsEmpty(CalleActual)
coincide = False
hoja.Activate
Set CalOf = LibroCal.ActiveSheet.Cells(i, 1)
Separar (CalleActual.Text)
Do While Not IsEmpty(CalOf)
If CalOf = UCase(CalleActual) Then
hoja.Cells(ren, Col + 1).Value = CalOf
hoja.Cells(ren, ColA + 2).Formula = hoja.Cells(ren, ColA + 1) & " " & hoja.Cells(ren, Col + 1) & ""
exacto = True
ren = ren + 1
Set CalleActual = hoja.Cells(ren, Col)
Exit Do
End If
For L = 0 To UBound(nom)
If (CalOf Like ("*" & UCase(nom(L)) & "*") And (nom(L) <> "")) Then
coincide = True
c = c + 1
End If
Next
If coincide And c = UBound(nom) + 1 And c > 1 Then
hoja.Cells(ren, Col + 1).Value = CalOf
hoja.Cells(ren, ColA + 2).Formula = hoja.Cells(ren, ColA + 1) & " " & hoja.Cells(ren, Col + 1) & ""
exacto = True
ren = ren + 1
Set CalleActual = hoja.Cells(ren, Col)
p = True
c = 0
Exit Do
End If
If coincide Then
FrmChequeo.LBxCalles.AddItem (CalOf)
coincide = False
End If
i = i + 1
Set CalOf = LibroCal.ActiveSheet.Cells(i, 1)
c = 0
Loop
If Not exacto Then
FrmChequeo.TxtTeo.Text = CalleActual
If FrmChequeo.LBxCalles.ListCount = 0 Then
'SepararUna (CalleActual)
FrmChequeo.LBxCalles.AddItem ("No se encuentran coincidencias")
FrmChequeo.CmbOK.Enabled = False
End If
hoja.Activate
FrmChequeo.LblCount.Caption = "Registros Encontrados: " & FrmChequeo.LBxCalles.ListCount
hoja.Cells(ren, Col).Activate
ActiveWindow.ScrollRow = ren
FrmChequeo.Show
Erase nom()
ren = ren + 1
Set CalleActual = hoja.Cells(ren, Col)
i = 2
c = 0
ElseIf p Then
p = False
i = 2
c = 0
'Exit Do
Else
Erase nom()
FrmChequeo.LBxCalles.Clear
exacto = False
i = 2
c = 0
End If
Loop

End Sub

Public Function Separar(Celda As String) As String
j = 0
enc = False
Pos1 = 0
aLen = Len(Celda)
aPos1 = Blanco(Celda, Pos1 + 1)
If aPos1 = 0 Then
st = Mid(Celda, aPos1 + 1, aLen - aPos1)
If ((UCase(st) <> "AV") And (UCase(st) <> "AV.")) Then
ReDim Preserve nom(j)
nom(j) = st
Exit Function
End If
End If
st = Left(Celda, aPos1 - 1)
If ((UCase(st) <> "AV") And (UCase(st) <> "AV.")) Then
If Len(st) > 3 Or IsNumeric(st) Then
ReDim Preserve nom(j)
nom(j) = st
Else
j = -1
End If
End If
aPos2 = Blanco(Celda, aPos1 + 1)
If aPos2 = 0 Then
st = Mid(Celda, aPos1 + 1, aLen - aPos1)
If ((UCase(st) <> "AV") And (UCase(st) <> "AV.")) Then
If Len(st) > 3 Or IsNumeric(st) Then
ReDim Preserve nom(j + 1)
nom(j + 1) = st
End If
Exit Function
End If
End If
Pos1 = aPos1 - 1
For i = Pos1 To aLen
j = j + 1
aPos1 = Blanco(Celda, Pos1 + 1)
aPos2 = Blanco(Celda, aPos1 + 1)
If aPos2 = 0 Then
st = Mid(Celda, aPos1 + 1, aLen - aPos1)
If Len(st) > 3 Or IsNumeric(st) Then
ReDim Preserve nom(j)
nom(j) = st
Else
j = j - 1
End If
Exit Function
End If
st = Mid(Celda, aPos1 + 1, aPos2 - aPos1 - 1)
If Len(st) > 3 Or IsNumeric(st) Then
ReDim Preserve nom(j)
nom(j) = st
Else
j = j - 1
End If
Pos1 = aPos1
Next
End Function
Public Function Blanco(Celda As String, Pose As Integer) As Integer
aLen = Len(Celda)
For i = Pose To aLen
If (Mid(Celda, i, 1) = " ") Then
Blanco = i
Exit Function
End If
Next
End Function
Public Function Encontrar(Celda As String) As Integer
enc = False
For j = 1 To aLen
aPos1 = Blanco(linea, 1 + 1)
aPos2 = Blanco(linea, aPos1 + 1)
If aPos2 = 0 Then
Exit Function
End If
st = Mid(linea, aPos1 + 1, aPos2 - aPos1 - 1)
Pose = aPos1
textol = texto + "*"
If (st = texto) Or (st Like textol) Then
aPos1 = Blanco(linea, aPos1 + 1)
aPos2 = Blanco(linea, aPos1 + 1)
enc = True
Exit Function
End If
Next
End Function
Public Function SepararUna(Celda As String) As String
j = 0
aLen = Len(Celda)
For i = 0 To aLen - 4
j = j + 1
st = Mid(Celda, i + 1, 4)
ReDim Preserve nom(j)
nom(j) = st
Next
End Function


Por favor algun experto en el tema necesito toda la ayuda posible :S