Modificación en la macro enviada, para mejor control.
Hola Dam hace algún tiempo me ayudaste con una macro para autocompletar celdas adyacentes a partir de la digitación de una celda y desde una base de datos en otro libro.
este es el código:
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.DAM
If Not Intersect(Target, Range("A:A")) Is Nothing Then
For Each d In Target
With Workbooks("IMPRESIÓN DE VALES 8").Sheets("IMPRESIÓN DE VALES 8")
Set b = .Range("A:A").Find(d.Value)
If Not b Is Nothing Then
Cells(d.Row, "B") = .Cells(b.Row, "B")
Cells(d.Row, "C") = .Cells(b.Row, "C")
Else
MsgBox "No existe el Vale: " & d.Value, vbCritical, "VALES"
d.Select
End If
End With
Next
End If
End Sub
Sin embargo, me gustaría un control mas:
Que cuando se digite el mismo código 2 veces en algún momento, me mande un error diciendo "código ya digitado", y borre la celda inmediatamente y por su puesto no autocomplete.
Seria genial si me proporcionarias esa ayuda.
Gracias de antemano
Cambia la macro por esta.
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.DAM
If Not Intersect(Target, Range("A:A")) Is Nothing Then
For Each d In Target
uf = Range("A" & Rows.Count).End(xlUp).Row
If uf = d.Row Then uf = uf + 2
a = d.Row - 1
b = d.Row + 1
e = False
Set s = Range("A1:A" & a).Find(d.Value)
If Not s Is Nothing Then
e = True
Else
Set r = Range("A" & b & ":A" & uf).Find(d.Value)
If Not r Is Nothing Then e = True
End If
If e Then
d.Select
MsgBox "código ya digitado: " & d.Value, vbCritical, "VALES"
Application.EnableEvents = False
d.Value = ""
Application.EnableEvents = True
Exit Sub
End If
With Workbooks("IMPRESIÓN DE VALES 8").Sheets("IMPRESIÓN DE VALES 8")
Set b = .Range("A:A").Find(d.Value)
If Not b Is Nothing Then
Cells(d.Row, "B") = .Cells(b.Row, "B")
Cells(d.Row, "C") = .Cells(b.Row, "C")
Else
d.Select
MsgBox "No existe el Vale: " & d.Value, vbCritical, "VALES"
Application.EnableEvents = False
d.Value = ""
Application.EnableEvents = True
End If
End With
Next
End If
End Sub Saludos.DAM
Si es lo que necesitas.
