Sorry, not even going to attempt to read that. I've never seen that result from using VBA code tags on this forum. Must have been something else?
Dim OpeningBalance As Double
Dim ObservedBalance As Double
Dim CalculatedBalance As Double
Dim TotalImbalance As Double
Dim TotalCalculatedBalance As Double
Dim DateInFlows As Double
Dim DatelOutFlows As Double
Dim DateDebtors As Double
Dim DateCreditors As Double
Dim SmallestDate As Date
Dim BiggestDate As Date
Dim DateToWorkOn As Date
Dim lastRowInIncomesColumn As Long
Dim lastRowInExpensesColumn As Long
Dim ReferenceBook As String
Dim EnteredValue As String
Set ws = ThisWorkbook.Sheets("sheet1")
Sheet1BalancingMethod = ""
'get user's desire to balance off the book
Response = MsgBox("You have initiated balancing off of this work-sheet. Do you want to continue?", vbQuestion + vbYesNo, "Confirmation")
If Response = vbYes Then
'INITIATE DATE ORDER
ws.Range("BD1:BG1").Calculate
'get biggest date
If ws.Cells(1, "BE").Value > ws.Cells(1, "BG").Value Then
BiggestDate = CDate(ws.Cells(1, "BE").Value)
Else
BiggestDate = CDate(ws.Cells(1, "BG").Value)
End If
'get smallest date
If ws.Cells(1, "BD").Value <= ws.Cells(1, "BF").Value And ws.Cells(1, "BD").Value <> 0 Then
SmallestDate = CDate(ws.Cells(1, "BD").Value)
ElseIf ws.Cells(1, "BF").Value <= ws.Cells(1, "BD").Value And ws.Cells(1, "BF").Value <> 0 Then
SmallestDate = CDate(ws.Cells(1, "BF").Value)
ElseIf ws.Cells(1, "BD").Value >= ws.Cells(1, "BF").Value And ws.Cells(1, "BF").Value = 0 Then
SmallestDate = CDate(ws.Cells(1, "BD").Value)
ElseIf ws.Cells(1, "BF").Value >= ws.Cells(1, "BD").Value And ws.Cells(1, "BD").Value = 0 Then
SmallestDate = CDate(ws.Cells(1, "BF").Value)
End If
If ws.Cells(1, "BD").Value = 0 And ws.Cells(1, "BF").Value = 0 Then
SmallestDate = BiggestDate
End If
'Set REFERENCE BOOK
If RemoveRepeatingSpaces(ws.Cells(3, "P").Value) = "" Then
ReferenceBook = InputBox("Enter the reference book U want to balance.")
Else
ReferenceBook = RemoveRepeatingSpaces(ws.Cells(3, "P").Value)
End If
'Check for presence of multiple reference books
If Application.WorksheetFunction.CountIfs(ws.Range("DA6:DA1048576"), ReferenceBook) + Application.WorksheetFunction.CountIfs(ws.Range("DK6:DK1048576"), ReferenceBook) <> Application.WorksheetFunction.CountA(ws.Range("DA6:DA1048576")) + Application.WorksheetFunction.CountA(ws.Range("DK6:DK1048576")) Then
ReferenceBook = RemoveRepeatingSpaces(InputBox("Multiple reference books found. Please confirm the reference book which you are balancing off."))
End If
If Application.WorksheetFunction.CountIfs(ws.Range("DA6:DA1048576"), ReferenceBook) + Application.WorksheetFunction.CountIfs(ws.Range("DK6:DK1048576"), ReferenceBook) = 0 Then
MsgBox ("The reference book provided has no entries made under it.")
Exit Sub
End If
If RemoveRepeatingSpaces(ReferenceBook) = "" Then
MsgBox ("Reference book is null.")
Exit Sub
End If
'Initialise values to paste at the end of procedure
TotalImbalance = 0
TotalCalculatedBalance = 0
'Check user desired balancing method
If SmallestDate <> BiggestDate Then
UserFormForBalancingOffSheet1.Show
'In case date is only one
Else
DateToWorkOn = BiggestDate
GoTo GeneralisedBalancing
End If
InvalidEntryHandlingPoint:
If Err.Number <> 0 Then
MsgBox ("Invalid value.")
Err.Clear
ws.Cells(3, "X").Calculate
Exit Sub
End If
On Error GoTo 0
'Update date ranges
If Sheet1BalancingMethod = "DATE-RANGE-ONE-BY-ONE" Or Sheet1BalancingMethod = "DATE-RANGE-ALL-AT-ONCE" Then
On Error GoTo InvalidEntryHandlingPoint
SmallestDate = DateValue(InputBox("Enter desired start date"))
BiggestDate = DateValue(InputBox("Enter desired end date"))
On Error GoTo 0
End If
'If desiring ONE-BY-ONE DATE BALANCING
If Sheet1BalancingMethod = "ALL-DATES-ONE-BY-ONE" Or Sheet1BalancingMethod = "DATE-RANGE-ONE-BY-ONE" Then
For DateToWorkOn = SmallestDate To BiggestDate
'In case the date has desired data
If Application.WorksheetFunction.CountIfs(ws.Range("DA6:DA1048576"), ReferenceBook, ws.Range("A6:A1048576"), DateToWorkOn) + Application.WorksheetFunction.CountIfs(ws.Range("DK6:DK1048576"), ReferenceBook, ws.Range("P6:P1048576"), DateToWorkOn) > 0 Then
On Error GoTo InvalidEntryHandlingPoint
OpeningBalance = Evaluate(InputBox("Enter the Opening balance for " & DateToWorkOn))
ObservedBalance = Evaluate(InputBox("Enter the observed closing balance for " & DateToWorkOn))
On Error GoTo 0
DateInFlows = Application.WorksheetFunction.SumIfs(ws.Range("H6:H1048576"), ws.Range("A6:A1048576"), DateToWorkOn, ws.Range("DA6:DA1048576"), ReferenceBook)
DateOutFlows = Application.WorksheetFunction.SumIfs(ws.Range("T6:T1048576"), ws.Range("P6:P1048576"), DateToWorkOn, ws.Range("DK6:DK1048576"), ReferenceBook)
DateDebtors = Application.WorksheetFunction.SumIfs(ws.Range("J6:J1048576"), ws.Range("A6:A1048576"), DateToWorkOn, ws.Range("DA6:DA1048576"), ReferenceBook)
DateCreditors = Application.WorksheetFunction.SumIfs(ws.Range("V6:V1048576"), ws.Range("P6:P1048576"), DateToWorkOn, ws.Range("DK6:DK1048576"), ReferenceBook)
CalculatedBalance = OpeningBalance + DateInFlows - DateDebtors - DateOutFlows + DateCreditors
If CalculatedBalance < ObservedBalance Then
'get the last row
lastRowInIncomesColumn = ws.Cells(ws.Rows.count, "C").End(xlUp).Row
If lastRowInIncomesColumn < 5 Then
lastRowInIncomesColumn = 5
End If
ws.Cells(lastRowInIncomesColumn + 1, "A").Value = DateToWorkOn
ws.Cells(lastRowInIncomesColumn + 1, "C").Value = "Unexplained income"
ws.Cells(lastRowInIncomesColumn + 1, "D").Value = 1
ws.Cells(lastRowInIncomesColumn + 1, "H").Value = ObservedBalance - CalculatedBalance
ws.Cells(lastRowInIncomesColumn + 1, "N").Value = "Bal-b/f=" & OpeningBalance & " " & "Obs.Bal=" & ObservedBalance & " " & "Calc.Bal=" & CalculatedBalance
ws.Cells(lastRowInIncomesColumn + 1, "O").Value = 0
ws.Cells(lastRowInIncomesColumn + 1, "DA").Value = ReferenceBook
ws.Cells(lastRowInIncomesColumn + 1, "A").EntireRow.Calculate
ElseIf CalculatedBalance > ObservedBalance Then
'get the last row
lastRowInExpensesColumn = ws.Cells(ws.Rows.count, "R").End(xlUp).Row
If lastRowInExpensesColumn < 5 Then
lastRowInExpensesColumn = 5
End If
ws.Cells(lastRowInExpensesColumn + 1, "P").Value = DateToWorkOn
ws.Cells(lastRowInExpensesColumn + 1, "R").Value = "Unexplained deficit"
ws.Cells(lastRowInExpensesColumn + 1, "S").Value = 1
ws.Cells(lastRowInExpensesColumn + 1, "T").Value = CalculatedBalance - ObservedBalance
ws.Cells(lastRowInExpensesColumn + 1, "Z").Value = "Bal-b/f=" & OpeningBalance & " " & "Obs.Bal=" & ObservedBalance & " " & "Calc.Bal=" & CalculatedBalance
ws.Cells(lastRowInExpensesColumn + 1, "AA").Value = 0
ws.Cells(lastRowInExpensesColumn + 1, "DK").Value = ReferenceBook
ws.Cells(lastRowInExpensesColumn + 1, "A").EntireRow.Calculate
End If
TotalImbalance = TotalImbalance + (ObservedBalance - CalculatedBalance)
TotalCalculatedBalance = TotalCalculatedBalance + CalculatedBalance
End If
Next DateToWorkOn
'If desiring AT-ONCE BALANCING
ElseIf Sheet1BalancingMethod = "ALL-DATES-ONE-BY-ONCE" Or Sheet1BalancingMethod = "DATE-RANGE-ALL-AT-ONCE" Then
GeneralisedBalancing:
On Error GoTo InvalidEntryHandlingPoint
OpeningBalance = Evaluate(InputBox("Enter the total Opening balance"))
ObservedBalance = Evaluate(InputBox("Enter the total Observed closing balance"))
On Error GoTo 0
DateInFlows = Application.WorksheetFunction.SumIfs(ws.Range("H6:H1048576"), ws.Range("A6:A1048576"), ">=SmallestDate", ws.Range("A6:A1048576"), "<=BiggestDate", ws.Range("DA6:DA1048576"), ReferenceBook)
DateOutFlows = Application.WorksheetFunction.SumIfs(ws.Range("T6:T1048576"), ws.Range("P6:P1048576"), ">=SmallestDate", ws.Range("P6:P1048576"), "<=BiggestDate", ws.Range("DK6:DK1048576"), ReferenceBook)
DateDebtors = Application.WorksheetFunction.SumIfs(ws.Range("J6:J1048576"), ws.Range("A6:A1048576"), ">=SmallestDate", ws.Range("A6:A1048576"), "<=BiggestDate", ws.Range("DA6:DA1048576"), ReferenceBook)
DateCreditors = Application.WorksheetFunction.SumIfs(ws.Range("V6:V1048576"), ws.Range("P6:P1048576"), ">=SmallestDate", ws.Range("P6:P1048576"), "<=BiggestDate", ws.Range("DK6:DK1048576"), ReferenceBook)
CalculatedBalance = OpeningBalance + DateInFlows - DateDebtors - DateOutFlows + DateCreditors
If CalculatedBalance < ObservedBalance Then
'get the last row
lastRowInIncomesColumn = ws.Cells(ws.Rows.count, "C").End(xlUp).Row
If lastRowInIncomesColumn < 5 Then
lastRowInIncomesColumn = 5
End If
ws.Cells(lastRowInIncomesColumn + 1, "A").Value = BiggestDate
ws.Cells(lastRowInIncomesColumn + 1, "C").Value = "Unexplained income"
ws.Cells(lastRowInIncomesColumn + 1, "D").Value = 1
ws.Cells(lastRowInIncomesColumn + 1, "H").Value = ObservedBalance - CalculatedBalance
ws.Cells(lastRowInIncomesColumn + 1, "N").Value = "Bal-b/f=" & OpeningBalance & " " & "Obs.Bal=" & ObservedBalance & " " & "Calc.Bal=" & CalculatedBalance
ws.Cells(lastRowInIncomesColumn + 1, "O").Value = 0
ws.Cells(lastRowInIncomesColumn + 1, "DA").Value = ReferenceBook
ws.Cells(lastRowInIncomesColumn + 1, "A").EntireRow.Calculate
ElseIf CalculatedBalance > ObservedBalance Then
'get the last row
lastRowInExpensesColumn = ws.Cells(ws.Rows.count, "R").End(xlUp).Row
If lastRowInExpensesColumn < 5 Then
lastRowInExpensesColumn = 5
End If
ws.Cells(lastRowInExpensesColumn + 1, "P").Value = BiggestDate
ws.Cells(lastRowInExpensesColumn + 1, "R").Value = "Unexplained deficit"
ws.Cells(lastRowInExpensesColumn + 1, "S").Value = 1
ws.Cells(lastRowInExpensesColumn + 1, "T").Value = CalculatedBalance - ObservedBalance
ws.Cells(lastRowInExpensesColumn + 1, "Z").Value = "Bal-b/f=" & OpeningBalance & " " & "Obs.Bal=" & ObservedBalance & " " & "Calc.Bal=" & CalculatedBalance
ws.Cells(lastRowInExpensesColumn + 1, "AA").Value = 0
ws.Cells(lastRowInExpensesColumn + 1, "DK").Value = ReferenceBook
ws.Cells(lastRowInExpensesColumn + 1, "A").EntireRow.Calculate
End If
TotalImbalance = TotalImbalance + (ObservedBalance - CalculatedBalance)
TotalCalculatedBalance = TotalCalculatedBalance + CalculatedBalance
'CANCEL
ElseIf Sheet1BalancingMethod = "CANCEL" Then
Exit Sub
End If
'Reset balancing method
Sheet1BalancingMethod = ""
ws.Cells(3, "S").Value = TotalCalculatedBalance
ws.Cells(3, "X").Calculate
MsgBox ("Total Calculated cash balance is " & TotalCalculatedBalance)
If TotalImbalance >= 0 Then
MsgBox ("Net unexplained surplus is " & TotalImbalance)
Else
MsgBox ("Net unexplained deficit is " & Right(TotalImbalance, Len(TotalImbalance) - 1))
End If
End If
End Sub
Hope this gets u better motivation to help