Managing ledgers in Excel can be time-consuming, especially when dealing with large amounts of data. Automating the process with VBA (Visual Basic for Applications) simplifies the task, ensuring efficiency and accuracy.
Why Use This VBA Code?
This VBA script refines your ledger data by:
- Handling both Group and Single ledgers.
- Managing narration entries.
- Removing merged cells.
- Formatting data for readability.
- Automating tedious tasks, reducing manual work.
How it works?
The VBA code prompts users to specify whether they are working on a Group or Single ledger. It ensures that the data structure aligns with the specified ledger type before proceeding with modifications. Users are also asked if their ledger includes narration, allowing the script to tailor processing accordingly.
Features of the Ledger Refiner
- Ledger Type Selection: Ensures correct processing based on the chosen ledger type.
- Narration Handling: Moves and organizes narration data appropriately.
- Data Cleanup: Removes unnecessary rows, blank cells, and merged formatting.
- Column Adjustments: Adds and renames columns for a structured ledger format.
- Formatting Enhancements: Adjusts font styles, sizes, and colors for better readability.
Download the Full VBA Code
For full access to the advanced version of this VBA script, click below to download the complete code:
Trial Version
If you want to test the script before downloading the full version, you can use the following trial version of the code. This version allows processing only for Single ledgers and includes a message directing users to the full version for complete access.
Sub M14_Ledger_Refiner()
Dim ledgerType As String
' Ask user for ledger type
ledgerType = InputBox("Are you working on a Single ledger? Enter 'S':")
If UCase(ledgerType) = "S" Then
' Check if "Date" is present in cell A6
If InStr(1, UCase(Range("A6").Value), "DATE") = 0 Then
MsgBox "Error: 'Date' is not found in cell A6. If you're working with only one ledger, make sure the 'Dates heading' starts from A6.", vbExclamation
Exit Sub
End If
Else
MsgBox "Invalid ledger type entered. Please enter 'S' for a Single Ledger. For full access to this VBA code, visit my website: BlogCellDocs.", vbExclamation
Exit Sub
End If
' Prompt the user to input Yes or No
Dim response As String
response = InputBox("Does your Data Ledger include Narration? (Yes/No)")
' Check the user's response
If UCase(response) = "YES" Then
' Call the M6_Ledger_Modifier subroutine
M6_Ledger_Modifier
ElseIf UCase(response) = "NO" Then
' Do nothing
Else
MsgBox "Invalid input. Please enter Yes or No.", vbExclamation
Exit Sub
End If
' Disable Excel features for better performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' Remove merged cells
RemoveMergedCells
' Call M16_AddColumnAndCopyData subroutine
M16_AddColumnAndCopyData
' Display final message
MsgBox "I have completed my work. Now, it's your turn!"
' Enable Excel features back
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
Sub RemoveMergedCells()
Dim ws As Worksheet
Dim rng As Range
Dim mergedCell As Range
' Set the worksheet
Set ws = ActiveWorkbook.ActiveSheet
' Loop through each cell in the worksheet
For Each mergedCell In ws.UsedRange
If mergedCell.MergeCells Then
mergedCell.MergeCells = False
End If
Next mergedCell
End Sub
Sub M16_AddColumnAndCopyData()
Dim ws As Worksheet
Dim lastRow As Long
Dim lastColumn As Long
Dim i As Long
Set ws = ActiveSheet 'Change this line if needed
'Add a new column at position 1
ws.Columns("A").EntireColumn.Insert Shift:=xlToRight
'Find the last non-empty row in column B
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).row
'Find the last non-empty column in row 6
lastColumn = ws.Cells(6, ws.Columns.Count).End(xlToLeft).Column
'Copy the data from B1:B4 to A1:A4
ws.Range("B1:B4").Cut Destination:=ws.Range("A1")
'Loop through each row starting from the last row and moving upward
For i = lastRow To 2 Step -1
If InStr(ws.Cells(i, 2).Value, "Ledger:") > 0 Then
'If "Ledger:" found in B column, copy value from C column and paste it in A column
ws.Cells(i, 1).Value = ws.Cells(i, 3).Value
End If
Next i
' Fill the blank cells in column A with the value from the cell above until the last data value of column B
ws.Range("A6:A" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
' Convert the first column to values
ws.Range("A1:A" & lastRow).Value = ws.Range("A1:A" & lastRow).Value
' Remove rows containing "Date" and "Ledger:" from the 8th row
For i = lastRow To 8 Step -1
If InStr(ws.Cells(i, 2).Value, "Date") > 0 Or InStr(ws.Cells(i, 2).Value, "Ledger:") > 0 Then
ws.Rows(i).Delete
End If
Next i
' Remove blank cells in column C starting from the 8th row
For i = lastRow To 8 Step -1
If IsEmpty(ws.Cells(i, 3)) Then
ws.Rows(i).Delete
End If
Next i
' Remove entire row if there is a blank cell in column B starting from the 8th row
For i = lastRow To 8 Step -1
If ws.Cells(i, 2).Value = "" Then
ws.Rows(i).Delete
End If
Next i
' Check if there is text "Date" in cell B6, if true, type "Ledger Name" in the corresponding A6 cell
If ws.Cells(6, 2).Value = "Ledger:" Then
ws.Rows(6).Delete
End If
' Check if there is text "Ledger:" in cell B7, if true, remove the entire row
ws.Cells(6, 1).Value = "Ledger Name"
ws.Cells(6, 9).Value = "Narration"
ws.Cells(6, 4).Value = "Particulars"
ws.Cells(6, 3).Value = "Cr/Dr"
' Remove third row
ws.Rows(3).Delete
' Remove bold formatting
ws.Cells.Font.Bold = False
' Make the first 2 rows bold
ws.Range("A1:A2").Font.Bold = True
ws.Range("A5:I5").Font.Bold = True
' Remove existing borders
ws.Cells.Borders.LineStyle = xlNone
'Autofit rows and columns
ws.Rows.AutoFit
ws.Columns.AutoFit
' Set the width of column I to 65
ws.Columns("I").ColumnWidth = 65
' Wrap text in Column I
ws.Columns("I").WrapText = True
Set rangeToColor = ws.Range("A5:I5")
' Set cell color to RGB(98, 202, 227)
rangeToColor.Interior.Color = RGB(98, 202, 227)
'Set font to size 10
ws.Cells.Font.Size = 10
ws.Cells.Font.Name = "Trebuchet MS"
' Find the last row of data in Column I
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).row
' Define the data range from A6 to the last row in Column I
Set dataRange = ws.Range("A5:I" & lastRow)
' Add borders to the data range
With dataRange.Borders
.LineStyle = xlContinuous ' Set border style to continuous
.Weight = xlThin ' Set border weight to thin
.Color = RGB(0, 0, 0) ' Set border color to black
End With
End Sub
Conclusion
This VBA script provides an efficient way to manage ledgers in Excel. The full version is designed for comprehensive ledger handling, while the trial version gives users a glimpse into its capabilities. Download the full version today and streamline your accounting workflow!
For more automation tips and VBA scripts, stay tuned to BlogCellDocs!