Restar, pero no sumar

Hola Héctor

Siento el retraso, pero he estado fuera un par de días. He hecho lo que
decías (o lo he intentado hacer) pero sin resultados ( al menos positivos),
por lo visto no consigo 'colocarlo' en el lugar adecuado de mi código (que
por cierto tampoco es mío, puesto que me lo pasó Ignacio Pérez, de este
mismo grupo), lo mas que he conseguido es que funcione sin errores, pero no
lo 'calcula' bien.

==> [una disculpa... creo que no fui lo 'suficiente claro'] 'esas' líneas
son del 'ejemplo'

El que se debe disculpar soy yo, como te decía, soy nuevo en esto y por lo
que se ve bastante torpe. Te transcribo el código, por si puedes 'echarle un
vistazo'.
Muchas gracias de 'antemano' y espero no tener que molestar mas.

Un saludo
Jesús

modulo de código 'normal'

Dim Valor
Sub Registrar()

If Range("A4").Value = "" Then
MsgBox "Debes introducir una cantidad"
Exit Sub
End If
If Range("B4").Value = "" Then
MsgBox "Debes elegir una opción de la lista. " & vbCr & _
"Si no sabes, pide ayuda"
Exit Sub
End If
If Range("C4").Value = "" Then
MsgBox "Es necesario marcar una calidad"
Exit Sub
End If
If Range("D4").Value = "" Then
MsgBox "Hay que completar todos los campos"
Exit Sub
End If
If Range("E4").Value = "" Then
MsgBox "Falta poner la fecha"
Exit Sub
End If

Sheets("Movimientos").Unprotect Password:="xxxx"

Cantidad = Sheets("Hoja1").Range("A4").Value * Valor
TipoDeMaterial = Sheets("Hoja1").Range("B4").Value
Calidad = Sheets("Hoja1").Range("C4").Value
Proveedor = Sheets("Hoja1").Range("D4").Value
Fecha = Sheets("Hoja1").Range("E4").Value
Observaciones = Sheets("Hoja1").Range("F4").Value

Fila = Sheets("Movimientos").Range("A65536").End(xlUp).Row + 1

Sheets("Movimientos").Range("A" & Fila).Value = Cantidad
Sheets("Movimientos").Range("B" & Fila).Value = TipoDeMaterial
Sheets("Movimientos").Range("C" & Fila).Value = Calidad
Sheets("Movimientos").Range("D" & Fila).Value = Proveedor
Sheets("Movimientos").Range("E" & Fila).Value = Fecha
Sheets("Movimientos").Range("F" & Fila).Value = Observaciones


With Sheets(Calidad).Cells
Set c = .Find(TipoDeMaterial, LookIn:=xlValues)
If Not c Is Nothing Then
Set x = .Find(Proveedor, LookIn:=xlValues)
If Not x Is Nothing Then
Fila = c.Row
Columna = x.Column
Sheets(Calidad).Cells(Fila, Columna).Value = _
Sheets(Calidad).Cells(Fila, Columna).Value + Cantidad
End If
End If
End With
Sheets("Hoja1").Range("A4:F4").ClearContents
Sheets("Movimientos").Protect Password:="xxxx"

End Sub

Sub Sumar()
Valor = 1
Registrar
End Sub

Sub Restar()
Valor = -1
Registrar
End Sub

hola, Jesus !

... no consigo 'colocarlo' en el lugar adecuado ... he conseguido que funcione sin errores, pero no lo 'calcula' bien.
... transcribo el codigo, por si puedes 'echarle un vistazo'.

1.- supongo que en 'Hoja1' =>¿control de inventarios?<= ... 'usas' ...
- ¿botones? para sumar [¿entradas?] o restar [¿salidas?]
- celdas con validacion para 'tomar'... materiales, proveedores, [la hoja de 'calidad'] ...
2.- estoy tomando como base los mismos 'supuestos' anteriores [modifica donde corresponda] :))
=> las hojas ['calidad'] son varias y el rango de datos es variable :\\ 'pero...' con las siguientes 'constantes':
a) empieza desde 'A1' => la primer fila y la primer columna son [o pudieran ser] 'titulos' < => si las hojas [de 'calidad'] NO inician en 'A1'... modifica en el modulo del libro en 'Workbook_SheetChange' < b) la penultima columna es la sumatoria de las 'afectables'
c) la siguiente columna [ultima] es donde 'va' el dato a 'corregirse'
3.- 'determino' el rango 'afectable' usando la propiedad 'CurrentRegion' [y el metodo 'Resize']
=> si tienes 'otras' columnas [fuera de la 'base de datos'], ASEGURATE de 'separarlas' [al menos] por 1 columna <4.- agregue algunas 'monerias' [funciones personalizadas] para ...
- verificar [previo al registro] que NO falten datos 'por llenar' [en 'Hoja1'] en un solo paso ;)
- revisar [al abrir el libro] cada hoja y si esta protegida... que 'permita' que las macros hagan 'cambios'
=> solo ASEGURATE que NO haya otros codigos 'manipulando' una [des-][re-]proteccion de hojas <5.- en teoria... 'debiera funcionar' [obviamente dado que no 'dispongo' de 'tus' hojas de 'calidad' o de su 'arreglo']
asi que... espero tus comentarios acerca de las 'fallas' en mis 'supuestos' :((

saludos,
hector.

en el modulo de codigo del libro [ThisWorkbook] ==Private Sub Workbook_Open(): Dim Hoja As Worksheet
For Each Hoja In Worksheets
If VerProteccion(Hoja) <> 0 Then Hoja.Protect UserInterfaceOnly:=True
Next
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Monitorear Then Exit Sub
With Sh.Range("a1").CurrentRegion
ColCambio = .Column + .Columns.Count - 1
RangoDatos = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 3).Address
End With
If Intersect(Target, Sh.Range(RangoDatos)) Is Nothing Then Exit Sub
Cambio = Target - DatoAnterior
If Cambio >= 0 Then Exit Sub
With Sh.Cells(Target.Row, ColCambio)
Application.EnableEvents = False
If .Value + Cambio <= 0 Then .ClearContents Else .Value = .Value + Cambio
Application.EnableEvents = True
End With
End Sub

en un modulo de codigo 'normal' ==Option Private Module
Public DatoAnterior As Double, Cambio As Double, _
ColCambio As Integer, RangoDatos As String, _
Monitorear As Boolean, Registro As Integer
Function VerProteccion(ByRef Hoja As Worksheet) As Long
VerProteccion = Hoja.ProtectContents
If VerProteccion Then
On Error Resume Next: Hoja.Unprotect ""
On Error GoTo 0
If Hoja.ProtectContents Then VerProteccion = -VerProteccion Else Hoja.Protect
End If
End Function
Function Continuar() As Boolean: Dim Aviso As String: Aviso = ""
If IsEmpty(Range("a4")) Then Aviso = "A4 -> La cantidad." & vbCr
If IsEmpty(Range("b4")) Then Aviso = Aviso & "B4 -> Selección de material." & vbCr
If IsEmpty(Range("c4")) Then Aviso = Aviso & "C4 -> Selección de calidad." & vbCr
If IsEmpty(Range("d4")) Then Aviso = Aviso & "D4 -> Datos del proveedor." & vbCr
If IsEmpty(Range("e4")) Then Aviso = Aviso & "E4 -> La fecha."
If Aviso <> "" Then
Continuar = False
MsgBox "Falta completar los siguientes campos:" & vbCr & Aviso & _
"Favor de ""completarlo/s"".", vbInformation
Else: Continuar = True
End If
End Function
Sub Sumar()
If Not Continuar Then Exit Sub
Registro = 1: Registrar
End Sub
Sub Restar()
If Not Continuar Then Exit Sub
Registro = -1: Registrar
End Sub
Sub Registrar()
Dim Cantidad As Double, Calidad As String, Material As String, Proveedor As String, _
Fila As Long, Col As Integer, CeldaMat As Range, CeldaProv As Range, _
Falta As String
With Worksheets("Hoja1")
Cantidad = .Range("a4") * Registro
Material = .Range("b4")
Calidad = .Range("c4")
Proveedor = .Range("d4")
End With
Fila = Worksheets("Movimientos").Range("a65536").End(xlUp).Row + 1
With Worksheets("Movimientos")
.Range("a" & Fila) = Cantidad
.Range("b" & Fila) = Material
.Range("c" & Fila) = Calidad
.Range("d" & Fila) = Proveedor
.Range("e" & Fila) = Worksheets("Hoja1").Range("e4")
.Range("f" & Fila) = Worksheets("Hoja1").Range("f4")
End With
With Worksheets(Calidad)
Set CeldaMat = .Cells.Find(Material, LookIn:=xlValues)
If Not CeldaMat Is Nothing Then
Set CeldaProv = .Cells.Find(Proveedor, LookIn:=xlValues)
If Not CeldaProv Is Nothing Then
Fila = CeldaMat.Row
Col = CeldaProv.Column
Monitorear = True
DatoAnterior = .Cells(Fila, Col)
.Cells(Fila, Col) = .Cells(Fila, Col) + Cantidad
Monitorear = False
Set CeldaProv = Nothing
Else: Falta = "NO se localizó el proveedor: " & Proveedor
End If
Set CeldaMat = Nothing
Else: Falta = "NO se localizó el material: " & Material
End If
End With
If Falta = "" _
Then MsgBox "La operación se ha registrado con éxito." _
Else MsgBox "La operación NO se pudo registrar, debido a que" & vbCr & Falta
Worksheets("Hoja1").Range("a4:f4").ClearContents
End Sub

Hola Héctor,

Es PERFECTO, supera con creces lo que esperaba.
Muchas GRACIAS por todo. Algún día espero poder hacer algo 'parecido'
(supongo que un día bastante lejano).

Un saludo
Jesús

hola, Jesus !

Muchas GRACIAS por todo.

gracias por el 'feed-back' [y me alegra haber 'acertado' en los 'supuestos'] :))

y... estoy SEGURO de que 'ese' dia... NO esta 'muy lejano' ;)

saludos,
hector.