Problemas para calcular la suma total y su formato

Expertos alguien me podría ayudar tengo un formulario productos que me guarda, modifica y elimina correctamente, el problema que tengo es que al final de la ultima fila quiero que me aparezca la suma total y la palabra total al momento que vaya ingresando, modificando o eliminando registros la suma y su palabra total corra su correlativo sin perder su formato rojo y se actualice al momento que ingrese, modifique o elimine.

Esta imagen es cuando le agregue ese código para calcular la suma la cual cuando modifico y elimino se duplica el resultado pero cuando guarda no hay problema pero cuando inicia los registros.

Esta imagen es como quiero que quede con ese formato rojo en la palabra total y su rango de suma que cuando elimine, modifique y guarde no altere ese formato y se actualice todo.

Respuesta

Prueba esta macro, sustituí el combobox por un textbox, al momento de capturar y presionar enter alterna colores entre las filas y actualiza el total

Sorry omiti el codigo, es este

Private Sub CommandButton1_Click()
Set datos = Range("A1").CurrentRegion
With datos
    FILAS = .Rows.Count
    TITULO = .Cells(FILAS, 1) = "TOTAL"
    If TITULO Then
        .Rows(FILAS).Clear
        FILAS = FILAS - 1
    End If
    .Cells(FILAS + 1, 1) = TextBox1.Text
    .Cells(FILAS + 1, 2) = TextBox2.Text
    If WorksheetFunction.IsEven(FILAS) Then .Rows(FILAS + 1).Interior.ColorIndex = 16
    If WorksheetFunction.IsOdd(FILAS) Then .Rows(FILAS + 1).Interior.ColorIndex = 15
    .Cells(FILAS + 2, 1) = "TOTAL"
    .Cells(FILAS + 2, 2) = WorksheetFunction.Sum(.Cells(2, 2).Resize(FILAS))
    .Rows(FILAS + 2).Interior.ColorIndex = 3
    .Rows(FILAS + 2).Font.ColorIndex = 2
End With
Set datos = Nothing
End Sub

1 respuesta más de otro experto

Respuesta
2

¿Algo así?

Esto es una captura de pantalla que hice como vídeo con GIF:

Link al video Demo

Mira ese pequeño vídeo que grabe simulando lo que necesitas, si es eso lo que quieres, avísame para darte el código.


Experto Andy Machin, ya vi demo excelente es lo que estoy buscando. 

Experto Andy Machin, ya vi demo excelente es lo que estoy buscando, para que me comparta el código.

Descarga el libro y obsérvelo usted misma. Si tiene conocimiento de VBA podrá entenderlo, si no entiende algo, me lo pregunta:

Descargar libro por Mega

Le explico más o menos el funcionamiento.

Hay dos funciones en un modulo estándar. Una es para cargar el combobox, y la otra es para hacer la suma del total.

En el evento Initialize del formulario, se llama a la macro que carga el combobox, y también a la suma.

En el evento del botón Agregar/Modificar, si se selecciona un Producto del combobox, se asume que se quiere modificar, y se modifica el valor (el valor esta siendo asignado por el BoundColumn del combobox)

Si el texto no es parte de la lista, se asume que es un producto nuevo, y se agrega.

Luego se vuelve a cargar el combobox actualizado con el nuevo producto, en el caso de modificar, no es necesario cargarlo nuevamente, ya que el valor se adjudica a través del BoundColumn

En el caso de eliminar, simplemente se elimina la fila.

La fila del Total siempre permanecerá intacta, porque la macro esta trabajando con "la ultima fila - 1"

Si el enlace de arriba te pide una clave, intenta con este:

Descargar libro por Mega 2

Andy M.

¡Gracias! 


Experto Andy Machin, excelente el código es justo lo que estaba buscando para la suma de rangos muchas gracias,

Saludos

Amigo pero hay un problema cuando cuando no hay registros sale error, supongamos que tenga mi hoja vacía y quiero cargar mis registros desde cero cuando le doy ejecutar sale error, y cuando elimino el ultimo registro también me sale esto, se supone que cuando no hay registro no debería aparecer nada ni TOTAL NI LA SUMA solo se calcule cuando haya registros y cuando le doy guardar por primera vez al registro no sale la palabra TOTAL y su rango de suma total.

Este es código que he estado usando para mi macros

Private Sub cmd_Agregar_Click()
    Dim i As Integer
    If cbo_Nombre.Text = "" Then
        MsgBox "Nombre inválido", vbInformation + vbOKOnly
        cbo_Nombre.SetFocus
        Exit Sub
    End If
    If Not (Mid(cbo_Nombre.Text, 1, 1) Like "[a-z]" Or Mid(cbo_Nombre.Text, 1, 1) Like "[A-Z]") Then
        MsgBox "Nombre inválido", vbInformation + vbOKOnly
        cbo_Nombre.SetFocus
        Exit Sub
    End If
    For i = 2 To Len(cbo_Nombre.Text)
        If Mid(cbo_Nombre.Text, i, 1) Like "#" Then
            MsgBox "Nombre inválido", vbInformation + vbOKOnly
            cbo_Nombre.SetFocus
            Exit Sub
        End If
    Next
    Sheets("Productos").Activate
    Dim sproducto As Integer
    sproducto = nproductos(cbo_Nombre.Text)
    If sproducto = 0 Then
        Do While Not IsEmpty(ActiveCell)
            ActiveCell.Offset(1, 0).Activate ' si el registro no existe, se va al final.
        Loop
    Else
        Cells(sproducto, 1).Select  ' cuando ya existe el registro, cumple esta condición.
    End If
    'Aqui es cuando agregamos o modificamos el registro
    Application.ScreenUpdating = False
    ActiveCell = cbo_Nombre
    ActiveCell.Offset(0, 1) = Val(TxtCantidad)
    Application.ScreenUpdating = True
    LimpiarFormulario
    cbo_Nombre.SetFocus
    Sumar
End Sub
Private Sub cmd_Eliminar_Click()
    Dim fproductos As Integer
    fproductos = nproductos(cbo_Nombre.Text)
    If fproductos = 0 Then
        MsgBox "El producto que usted quiere eliminar no existe", vbInformation + vbOKOnly
        cbo_Nombre.SetFocus
        Exit Sub
    End If
    If MsgBox("¿Seguro que quiere eliminar este producto?", vbQuestion + vbYesNo) = vbYes Then
        Cells(fproductos, 1).Select
        ActiveCell.EntireRow.Delete
        LimpiarFormulario
        MsgBox "producto eliminado", vbInformation + vbOKOnly
        cbo_Nombre.SetFocus
   End If
End Sub
Private Sub cmd_Cerrar_Click()
End
End Sub
Private Sub cbo_Nombre_Change()
On Error Resume Next
    If nproductos(cbo_Nombre.Text) <> 0 Then
        Sheets("Productos").Activate
        Cells(cbo_Nombre.ListIndex + 2, 1).Select
        TxtCantidad = ActiveCell.Offset(0, 1)
    Else
        TxtCantidad = ""
    End If
End Sub
Private Sub cbo_Nombre_Enter()
CargarLista
End Sub
Sub CargarLista()
   cbo_Nombre.Clear
    Sheets("Productos").Select
    Range("A2").Select
    Do While Not IsEmpty(ActiveCell)
        cbo_Nombre.AddItem ActiveCell.Value
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub
Sub LimpiarFormulario()
    CargarLista
    cbo_Nombre = ""
    TxtCantidad = ""
End Sub
Sub Sumar()
Dim Uf As String
Dim Suma As Double
With Hoja2
 Uf = .Range("B" & Rows.Count).End(xlUp).Row
        Suma = Application.WorksheetFunction.Sum(.Range("B2:B" & Uf))
        .Range("B" & Uf + 1) = Format(Suma, "#,##0")
End With
End Sub

Yo escribí eso bastante rápido solo para que tomara la idea, asumiendo que siempre habría almeno un dato, y que usted podía corregir cualquier problemilla. Permítame unos minutos para hacerle el arreglarlo y se lo vuelvo a mandar.

Vale, aquí está el archivo otra vez, teniendo eso en cuenta y algún par de condiciones más que le agregué. Puede que aun tenga algún detalle que corregir, pero seguro que puedes con eso.

Aquí un pequeño demo:

Video demo

Y aquí el nuevo archivo:

Archivo actualizado

Andy M.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas