Calcular saldo entre fecha y fecha




Este procedimiento de VBA o Macro de Excel determina el saldo por proveedor o puede usarse para clientes, entre fecha y fecha, también se puede adaptar el ejemplo para tener gestionada una cuenta bancaria propia como por ejemplo la de MASTERCARD PAYONEER (si aún no la  tienes puedes gestionarla desde  el siguiente link); entregando un informe detallado de todos los movimientos que ha tenido la cuenta en el períodos seleccionado,  o si  se tilda la casilla correspondiente hace un resumen de todas la cuentas que tengan saldo distinto de cero, emitiendo un listado con todos los saldos dentro de los 60 días anteriores a la fecha del sistema; haciendo click en el link del final podrás descargar el ejemplo. 

Te recomiendo que leas un excelente libro sobre Excel para ello haz click acá. El código se encuentra a continuación, igualmente descargando el ejemplo lo podrás ver en funcionamiento, analizar, modificar y adaptar  a lo que tú estés realizando el  código está abierto sin ningún tipo de restricción.



Código que se introduce en formulario




Private Sub CheckBox1_AfterUpdate()
If CheckBox1.Value = True Then
TextBox3.Enabled = False
ComboBox1.Enabled = False
TextBox1.Enabled = False
TextBox2.Enabled = False
Else
TextBox3.Enabled = True
ComboBox1.Enabled = True
TextBox1.Enabled = True
TextBox2.Enabled = True
End If
End Sub


Private Sub ComboBox1_AfterUpdate()
Dim quebusco As String
Dim rangoabuscar As String
Dim busca As Object
Dim numerocuenta As String
rangoabuscar = "b2:b10000"
quebusco = ComboBox1.Value
Set busca = Sheets("Proveedores").Range(rangoabuscar).Find(quebusco, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing Then
TextBox3.Value = busca.Offset(0, -1)
Else
ComboBox1.SetFocus
MsgBox "El Proveedor no existe", vbCritical
End If
TextBox1 = CDate(Date - 60)
TextBox2 = CDate(Date)
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
'Controlo errores
On Error Resume Next
'Busca todos los Proveedores con saldo mayor a 0, si el checkbox es igual a true
If CheckBox1.Value = True Then
'Muestra progressbar
Unload Me
ProgressForm.Show False
Dim R As Integer
Dim MT As Double
For R = 1 To 10
 MT = Timer
 ProgressForm.ProgressBar1.Max = 10
 Do
  Loop While Timer - MT < 0.05
   ProgressForm.ProgressBar1.Value = R
 DoEvents
Next R
Unload ProgressForm

'Borra el contenido de la hoja saldo antes de empezar a calcular y pegar en celdas
Sheets("saldo").Visible = True
Sheets("saldo").Select
Sheets("saldo").Unprotect Password:="1111"
Range("d5:d7,c6,c10,f7,f5:g5,e10:f10,c10:h65536").ClearContents
'Busca los facturas ingresadas
Dim filafacturasST As Integer
Dim filapagosST As Integer
Dim filaProveedoresST As Integer
Dim filasaldoST As Integer
Dim facturasST As Currency
Dim AcumulafacturasST As Currency
Dim pagosST As Currency
Dim AcumulaPagoST As Currency
Dim saldoST As Currency
Dim cond1ST As String
Dim cond2ST As String
Dim cond3ST As String
Dim valor As Integer
Dim midate As Date

Dim dato1ST As String
Dim dato2ST As String
Dim dato3ST As String

filafacturasST = 2
filapagosST = 2
filaProveedoresST = 2
filasaldoST = 10
cond1ST = "Cancelada"
cond2ST = "Anulada"
cond3ST = "Falso"
'Busca importe de facturas
 Sheets("dbcomp").Visible = True
 Sheets("Proveedores").Visible = True

 While Sheets("Proveedores").Cells(filaProveedoresST, 2) <> Empty
           dato1ST = Sheets("Proveedores").Cells(filaProveedoresST, 2).Value
          
        While Sheets("dbcomp").Cells(filafacturasST, 3).Value <> Empty
                    
                 If dato1ST = Sheets("dbcomp").Cells(filafacturasST, 3).Value <> Empty And _
                    Sheets("dbcomp").Cells(filafacturasST, 13).Value <> cond2ST Then
                     facturasST = Sheets("dbcomp").Cells(filafacturasST, 8).Value
                     
                     filafacturasST = filafacturasST + 1
                  
                 Else
                     filafacturasST = filafacturasST + 1
                 End If
       AcumulafacturasST = AcumulafacturasST + facturasST
       facturasST = 0
       Wend
      
                     
     'Seguidamente busca pagos realizados antes de la ficha inicial
        While Sheets("dbcomp").Cells(filapagosST, 3).Value <> Empty
              dato2ST = Sheets("dbcomp").Cells(filapagosST, 13).Value
              dato3ST = Sheets("dbcomp").Cells(filapagosST, 9).Value
       
                 If dato1ST = Sheets("dbcomp").Cells(filapagosST, 3).Value And _
                    (dato2ST = cond1ST Or dato3ST = cond3ST) Then
                                  
                 pagosST = Sheets("dbcomp").Cells(filapagosST, 8).Value
       
                 filapagosST = filapagosST + 1
                Else
                 filapagosST = filapagosST + 1
                End If
       
        AcumulaPagoST = AcumulaPagoST + pagosST
        pagosST = 0
        Wend
       
   saldoST = AcumulafacturasST - AcumulaPagoST

   If saldoST <> 0 Then
   Sheets("saldo").Cells(filasaldoST, 3).Value = Date
   Sheets("saldo").Cells(filasaldoST, 4).Value = UCase(Sheets("Proveedores").Cells(filaProveedoresST, 2).Value)
   Sheets("saldo").Cells(filasaldoST, 5).Value = AcumulaPagoST
   Sheets("saldo").Cells(filasaldoST, 6).Value = AcumulafacturasST
   Sheets("saldo").Cells(filasaldoST, 7).Value = saldoST
  
   Sheets("saldo").Range("d5") = "Todas"
   Sheets("saldo").Range("d6") = "Todos"
   Sheets("saldo").Range("d7") = midate
   Sheets("saldo").Range("c6") = "Proveedores:"
  
   filasaldoST = filasaldoST + 1
  
   End If
 
  filaProveedoresST = filaProveedoresST + 1
  AcumulafacturasST = 0
  AcumulaPagoST = 0
  saldoST = 0
  filafacturasST = 2
  filapagosST = 2
Wend
'Ordena por fecha en forma ascendente y por concepto todo lo que parezca número
  Sheets("SALDO").Select
      Range("C10:h65500").Sort Key1:=Range("C10"), Order1:=xlAscending, Key2:=Range("D10"), _
      Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortNormal
'Llama a la rutina para dar formato
 FormatoCeldasSaldo
     
'Determina el total adeudado a los proveedores
valor = 0
Range("g9").Select
While ActiveCell <> Empty
ActiveCell.Offset(1, 0).Select
valor = valor + ActiveCell.Value
Wend
Range("f7") = valor

'Se oculta también la hoja cancela op , porque el saldo puede ser consuldado desde ahí
 'Sheets("cancela oP").Visible = xlVeryHidden
 'Sheets("dbcomp").Visible = xlVeryHidden
 'Sheets("Proveedores").Visible = xlVeryHidden
 Sheets("saldo").Protect Password:="1111"
 Sheets("saldo").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoSelection
 Sheets("saldo").Activate
 ActiveWindow.ScrollRow = 7
 Unload Me
 Exit Sub
 End If



'Si el check box no está tildado (es falso y quiero conocer el detalle) empieza la rutina desde aquí
'valida datos de el textbox1 Fecha
If Not IsDate(TextBox1.Text) Then
MsgBox "fecha inválida"
TextBox1.SetFocus
Exit Sub
End If
'Valida fecha
Dim ubica1, ubica2 As String
Dim dia, mes As Integer
Dim año, fecha As Integer
On Error Resume Next
'guardamos en variables el caracter encontrado en la posición 3 y 6
ubica1 = Mid(TextBox1.Text, 3, 1)
ubica2 = Mid(TextBox1.Text, 6, 1)
'comparamos si se trata de '/'
If ubica1 <> "/" Or ubica2 <> "/" Then
MsgBox ("Debes ingresar datos con este formato: dd/mm/aa")
TextBox1.SetFocus
Exit Sub
End If
dia = Mid(TextBox1.Value, 1, 2)
mes = Mid(TextBox1.Value, 4, 2)
año = Mid(TextBox1.Value, 7, 4)
fecha = Len(TextBox1)

'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia > 31 Or mes > 12 Or año < 1900 Or fecha > 10 Then
MsgBox "Fecha incorrecta"
TextBox1.SetFocus
Exit Sub
End If

'valida datos de el textbox2 Fecha
If Not IsDate(TextBox2.Text) Then
MsgBox "fecha inválida"
TextBox2.SetFocus
Exit Sub
End If
'Valida fecha
Dim ubica3, ubica4 As String
Dim dia1, mes1 As Integer
Dim año1, fecha1 As Integer
'guardamos en variables el caracter encontrado en la posición 3 y 6
ubica3 = Mid(TextBox2.Text, 3, 1)
ubica4 = Mid(TextBox2.Text, 6, 1)
'comparamos si se trata de '/'
If ubica3 <> "/" Or ubica4 <> "/" Then
MsgBox ("Debes ingresar datos con este formato: dd/mm/aa")
TextBox2.SetFocus
Exit Sub
End If
dia1 = Mid(TextBox2.Value, 1, 2)
mes1 = Mid(TextBox2.Value, 4, 2)
año1 = Mid(TextBox2.Value, 7, 4)
fecha1 = Len(TextBox2)

'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia1 > 31 Or mes1 > 12 Or año1 < 1900 Or fecha1 > 10 Then
MsgBox "Fecha incorrecta"
TextBox2.SetFocus
Exit Sub
End If

'Controla que la fecha final no sea menor a la inicial
Dim fechainicio As Date
Dim fechafinal As Date
fechainicio = TextBox1.Value
fechafinal = TextBox2.Value
If fechainicio > fechafinal Then
MsgBox "Fecha inválida"
TextBox2.SetFocus
Exit Sub
End If

'Controla que la fecha inicial no sea mayor a la fecha actual
Dim condicionfecha As Date
condicionfecha = TextBox1.Value
If condicionfecha > Date Then
MsgBox "La fecha inicial no puede ser mayor a la fecha actual"
Exit Sub
End If


If ComboBox1 = Empty Or TextBox1 = Empty Or TextBox2 = Empty Then
MsgBox "Debe completar todos los campos"
ComboBox1.SetFocus
Exit Sub
End If

Unload Me
ProgressForm.Show False
Dim R1 As Integer
Dim MT1 As Double
For R1 = 1 To 10
 MT1 = Timer
ProgressForm.ProgressBar1.Max = 10
 Do
  Loop While Timer - MT1 < 0.05
   ProgressForm.ProgressBar1.Value = R1 '"Progress: " & R & " de 180: " & _
   'Format(R / 180, "Percent") & " --- " & "Cumplimiento"
 DoEvents
Next R1
Unload ProgressForm


'Hace la hoja visible porque si no provoca error
'Selecciona la hoja donde va a pegar datos
'Desproteje la hoja
'Borra el contenido de la hoja saldo antes de empezar a calcular y pegar en celdas
Sheets("saldo").Visible = True
Sheets("saldo").Select
ActiveSheet.Unprotect Password:="1111"
Range("d5:d7,c6,c10,f5:g5,f7,e10:f10,c10:h65536").ClearContents
Sheets("dbcomp").Visible = True

'calcula saldo el saldo inicial para ello primero busca las facturas con fecha
'menor a la fecha inicial y luego los pagos con fecha menor a la fecha inicial
Dim filafacturasSI As Integer
Dim filapagosSI As Integer
Dim factura As Currency
Dim Acumulafactura As Currency
Dim pagos As Currency
Dim AcumulaP As Currency
Dim saldo As Currency
Dim cond1SI As String
Dim cond2SI As Date
Dim cond3SI As String
Dim cond4SI As String
Dim dato1SI As String
Dim dato2SI As Date
Dim dato3SI As String
Dim dato4SI As String

filafacturasSI = 2
filapagosSI = 2
cond1SI = ComboBox1.Value
cond2SI = TextBox1.Value
cond3SI = "Cancelada"
cond4SI = "Anulada"
'Busca importe de facturas menores a la ficha inicial
'Compara si es menor a la fecha inicial y pertenece al Proveedores seleccionado

 While Sheets("dbcomp").Cells(filafacturasSI, 1) <> Empty
            dato1SI = Sheets("dbcomp").Cells(filafacturasSI, 3).Value
            dato2SI = Sheets("dbcomp").Cells(filafacturasSI, 1).Value
           
             
        If dato1SI = cond1SI And _
           dato2SI < cond2SI And _
           Sheets("dbcomp").Cells(filafacturasSI, 13).Value <> cond4SI Then
           
           factura = Sheets("dbcomp").Cells(filafacturasSI, 8).Value
                     
           filafacturasSI = filafacturasSI + 1
          
        Else
           filafacturasSI = filafacturasSI + 1
        End If
       Acumulafactura = Acumulafactura + factura
      factura = 0
       Wend
      
      
      
      
      
     'Seguidamente busca pagos realizados antes de la ficha inicial
 While Sheets("dbcomp").Cells(filapagosSI, 1) <> Empty
            dato1SI = Sheets("dbcomp").Cells(filapagosSI, 3).Value
            dato2SI = Sheets("dbcomp").Cells(filapagosSI, 1).Value
            dato4SI = Sheets("dbcomp").Cells(filapagosSI, 13).Value
       
        If dato1SI = cond1SI And _
           dato2SI < cond2SI And _
           dato4SI = cond3SI Then
                     
          
           pagos = Sheets("dbcomp").Cells(filapagosSI, 8).Value
       
           filapagosSI = filapagosSI + 1
          
        Else
           filapagosSI = filapagosSI + 1
        End If
      AcumulaP = AcumulaP + pagos
      pagos = 0
        Wend
      
saldo = Acumulafactura - AcumulaP
      
      
'Se fija si el saldo es menor o mayor a cero y lo pone en la columna del debe o haber
'Sheets("saldo").Unprotect Password:="1111"
If saldo < 0 Then
Sheets("saldo").Cells(10, 5) = saldo * -1
Sheets("saldo").Cells(10, 7) = saldo
Else
Sheets("saldo").Select
ActiveSheet.Unprotect Password:="1111"
Sheets("saldo").Cells(10, 6) = saldo
Sheets("saldo").Cells(10, 7) = saldo
End If

'Agrega Proveedores de proveedor/cliente, cuenta, fecha etc
Sheets("saldo").Range("d5") = TextBox3.Value
Sheets("saldo").Range("d6") = ComboBox1.Value
Sheets("saldo").Range("d7") = Date
Sheets("saldo").Range("c6") = "Proveedores:"
Sheets("saldo").Range("f5") = CDate(TextBox1)
Sheets("saldo").Range("g5") = CDate(TextBox2)

' Luego de calcular el saldo inicial busca los datos entre las fechas ingresadas

Dim filapagos As Integer
Dim filasaldo As Integer
Dim dato1 As String
Dim dato2 As Date
Dim dato3 As Date
Dim dato4 As String
Dim dato5 As String
Dim dato6 As String
Dim cond1 As String
Dim cond2 As Date
Dim cond3 As Date
filafacturas = 2
filapagos = 2
filasaldo = 11

cond1 = ComboBox1.Value
cond2 = TextBox1.Value
cond3 = TextBox2.Value
'Realiza el bucle en la hoja dbcomp en busca de facturas mietras no haya filas vacias
'Busca facturas según datos ingresados
    While Sheets("dbcomp").Cells(filafacturas, 1) <> Empty
            dato1 = Sheets("dbcomp").Cells(filafacturas, 3).Value
            dato2 = Sheets("dbcomp").Cells(filafacturas, 1).Value
            dato3 = Sheets("dbcomp").Cells(filafacturas, 1).Value
            dato4 = Sheets("dbcomp").Cells(filafacturas, 4).Value
            dato5 = Sheets("dbcomp").Cells(filafacturas, 13).Value
               
        If dato1 = cond1 And _
           dato2 >= cond2 And _
           dato3 <= cond3 And _
           dato4 <> "NC" And _
           dato5 <> "Anulada" Then
         
           'si los datos coinciden con "factura , proveedor/cliente y las fechas los compia en la hoja saldos
          
           Sheets("dbcomp").Cells(filafacturas, 1).Copy Destination:=Sheets("saldo").Cells(filasaldo, 3)
           Sheets("dbcomp").Cells(filafacturas, 4).Copy Destination:=Sheets("saldo").Cells(filasaldo, 4)
           concepto1 = Sheets("dbcomp").Cells(filafacturas, 5)
           concepto2 = Sheets("dbcomp").Cells(filafacturas, 6)
           concepto3 = Sheets("dbcomp").Cells(filafacturas, 7)
           Sheets("saldo").Cells(filasaldo, 4) = Range("d" & filasaldo) & " " & concepto1 & " " & concepto2 & " " & concepto3
           Sheets("dbcomp").Cells(filafacturas, 8).Copy Destination:=Sheets("saldo").Cells(filasaldo, 6)
           Sheets("dbcomp").Cells(filafacturas, 19).Copy Destination:=Sheets("saldo").Cells(filasaldo, 8)
             
           filafacturas = filafacturas + 1
           filasaldo = filasaldo + 1
           Else
           filafacturas = filafacturas + 1
           End If
                   
       Wend
      
      
      
       'Realiza bucle en la hoja dbcomp buscando pagos para realizar las comparaciones y extraer datos coincidentes
       'Busca pagos según datos ingresados
       While Sheets("dbcomp").Cells(filapagos, 1) <> Empty
            dato1 = Sheets("dbcomp").Cells(filapagos, 3).Value
            dato2 = Sheets("dbcomp").Cells(filapagos, 1).Value
            dato3 = Sheets("dbcomp").Cells(filapagos, 1).Value
            dato4 = Sheets("dbcomp").Cells(filapagos, 4).Value
            dato6 = Sheets("dbcomp").Cells(filapagos, 13).Value
           
        If dato1 = cond1 And _
           dato2 >= cond2 And _
           dato3 <= cond3 And _
           dato4 <> "NC" And _
           dato6 = "Cancelada" Then
         
           'si los datos coinciden con el proveedor y las fechas los copia en la hoja saldos
          
           Sheets("dbcomp").Cells(filapagos, 1).Copy Destination:=Sheets("saldo").Cells(filasaldo, 3)
           Sheets("dbcomp").Cells(filapagos, 10).Copy Destination:=Sheets("saldo").Cells(filasaldo, 4)
           Sheets("saldo").Cells(filasaldo, 4) = "Orden de Pago Nº " & Range("d" & filasaldo)
           Sheets("dbcomp").Cells(filapagos, 8).Copy Destination:=Sheets("saldo").Cells(filasaldo, 5)
           Sheets("dbcomp").Cells(filapagos, 19).Copy Destination:=Sheets("saldo").Cells(filasaldo, 8)
          
        filapagos = filapagos + 1
        filasaldo = filasaldo + 1
        Else
           filapagos = filapagos + 1
           End If
                   
       Wend
      
  
     
    
'Ordena por fecha en forma ascendente y por concepto todo lo que parezca número
  Sheets("saldo").Select
      Range("C11:h65500").Sort Key1:=Range("C11"), Order1:=xlAscending, Key2:=Range("D11"), _
      Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortNormal
 
'Hace que la fecha del saldo inicial sea igual a la del primer dato
Sheets("saldo").Range("c10") = TextBox1 'Sheets("saldo").Range("c11")
Sheets("saldo").Range("d10") = "SALDO INICIAL AL: " & Range("c10")

'Por último calcula el saldo en cada celda
  Dim filsaldito As String
  Dim filfecha As String
  Dim saldito As Single
      
   filfecha = 11
   filsaldito = 10
     
    'Recorre todas las filas de la hoja saldo mientras no este vacia
   
   While Sheets("saldo").Cells(filfecha, 3) <> Empty
  
    Sheets("saldo").Cells(filfecha, 7).Value = Sheets("saldo").Cells(filsaldito, 7).Value + Sheets("saldo").Cells(filfecha, 6).Value - Sheets("saldo").Cells(filfecha, 5).Value
   
    filfecha = filfecha + 1
    filsaldito = filsaldito + 1
   
   Wend

 'Este procedimiento hace colocar el saldo en la celda f6 a modo resumen
 
  Sheets("saldo").Cells(7, 6).Value = Sheets("saldo").Cells(filsaldito, 7).Value + Sheets("saldo").Cells(filfecha, 6).Value - Sheets("saldo").Cells(filfecha, 5).Value

'ejecuta la rutina que le da formato a las celdas
FormatoCeldasSaldo
'Se posiciona la vista de la hoja en la fila 7
ActiveWindow.ScrollRow = 7
'oculta el formulario en el que se ingresa el saldo a buscar
Unload Me
'Se oculta también lo hoja cancela op , porque el saldo puede ser consuldado desde ahí
'Sheets("cancela oP").Visible = xlVeryHidden
'Sheets("dbcomp").Visible = xlVeryHidden
Sheets("saldo").Protect Password:="1111"
Sheets("saldo").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoSelection
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub textbox3_AfterUpdate()
Dim quebusco As String
Dim rangoabuscar As String
Dim busca As Object
On Error Resume Next
rangoabuscar = "a2:a10000"
quebusco = TextBox3.Text
Set busca = Sheets("Proveedores").Range(rangoabuscar).Find(quebusco, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing Then
ComboBox1 = busca.Offset(0, 1)
Else
MsgBox "No existe Proveedores o la cuenta esta mal ingresada" & Chr("saldo") & " Ingrese en formato 00000, ej. 00010, 01020", vbCritical
TextBox3.SetFocus
Exit Sub
End If
End Sub
Private Sub UserForm_Activate()
Application.ScreenUpdating = False
Sheets("proveedores").Activate
Range("b2").Select
Do While ActiveCell <> Empty
       ComboBox1.AddItem ActiveCell
       ActiveCell.Offset(1, 0).Select
Loop
End Sub



Código que se introduce en módulo

Sub muestrauserform5()
Load UserForm5
UserForm5.Show
End Sub




Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.



If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends