Votre panier est actuellement vide !
Catégorie : Excel VBA Course
Delete RowsColumns in Excel with VBA
VBA Code: Delete Rows and Columns in Excel
Sub DeleteRowsAndColumns() Dim ws As Worksheet Dim lastRow As Long, lastCol As Long Dim i As Long, j As Long ' Set the worksheet Set ws = ThisWorkbook.Sheets("Sheet1") ' Change the sheet name as needed ' Find the last row with data lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Find the last column with data lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' Delete rows where the first column (A) is empty For i = lastRow To 1 Step -1 ' Loop from last row to first (avoids shifting issues) If IsEmpty(ws.Cells(i, 1)) Then ws.Rows(i).Delete End If Next i ' Delete columns where the first row is empty For j = lastCol To 1 Step -1 ' Loop from last column to first (avoids shifting issues) If IsEmpty(ws.Cells(1, j)) Then ws.Columns(j).Delete End If Next j ' Clean up Set ws = Nothing End SubDetailed Explanation
- Defining the Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")- We define the worksheet where the operation will take place.
- You can replace « Sheet1 » with the actual name of your sheet.
- Finding the Last Row with Data
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
- ws.Rows.Count returns the total number of rows (typically 1,048,576 in modern Excel).
- End(xlUp) moves upwards from the last row in column A to find the last non-empty cell.
- This helps us determine where the data stops.
- Finding the Last Column with Data
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
- ws.Columns.Count returns the total number of columns (typically 16,384 in Excel).
- End(xlToLeft) moves leftward from the last column in row 1 to find the last non-empty cell.
- This helps us determine where the data stops horizontally.
- Deleting Rows Where Column A is Empty
For i = lastRow To 1 Step -1 If IsEmpty(ws.Cells(i, 1)) Then ws.Rows(i).Delete End If Next i
- The loop starts from the last row and moves upwards (Step -1).
- IsEmpty(ws.Cells(i, 1)) checks if the cell in column A is empty.
- If the condition is met, the entire row is deleted.
- The loop moves in reverse order to avoid shifting issues when deleting rows.
- Deleting Columns Where Row 1 is Empty
For j = lastCol To 1 Step -1 If IsEmpty(ws.Cells(1, j)) Then ws.Columns(j).Delete End If Next j
- The loop starts from the last column and moves leftwards.
- IsEmpty(ws.Cells(1, j)) checks if the cell in row 1 is empty.
- If true, the entire column is deleted.
- The reverse loop prevents errors caused by column shifting.
- Cleaning Up
Set ws = Nothing
- This releases the worksheet object from memory to optimize performance.
Key Features
Deletes empty rows based on column A.
Deletes empty columns based on row 1.
Uses reverse loops to avoid shifting issues.
Works dynamically by detecting last used row/column.Delete Empty Worksheets with Excel VBA
Delete Empty Worksheets VBA Code:
Sub DeleteEmptyWorksheets() Dim ws As Worksheet Dim wsCount As Integer Dim i As Integer Dim lastRow As Long, lastCol As Long Dim wsToDelete As Collection Dim wsName As String Dim response As VbMsgBoxResult ' Initialize a collection to store empty worksheet names Set wsToDelete = New Collection ' Count the total number of worksheets wsCount = ThisWorkbook.Worksheets.Count ' Prevent deletion if only one worksheet remains If wsCount = 1 Then MsgBox "Cannot delete the only worksheet in the workbook!", vbExclamation, "Delete Empty Worksheets" Exit Sub End If ' Loop through each worksheet in the workbook For Each ws In ThisWorkbook.Worksheets ' Find the last used row and column lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lastCol = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column ' If no used range is found, the worksheet is empty If lastRow = 1 And lastCol = 1 Then If Application.WorksheetFunction.CountA(ws.Cells) = 0 Then ' Store the worksheet name in the collection wsToDelete.Add ws.Name End If End If Next ws ' Confirm deletion if there are empty worksheets If wsToDelete.Count > 0 Then wsName = "The following empty worksheets will be deleted:" & vbNewLine & vbNewLine For i = 1 To wsToDelete.Count wsName = wsName & wsToDelete(i) & vbNewLine Next i response = MsgBox(wsName & vbNewLine & "Do you want to proceed?", vbYesNo + vbQuestion, "Confirm Deletion") If response = vbYes Then Application.DisplayAlerts = False For i = 1 To wsToDelete.Count ThisWorkbook.Worksheets(wsToDelete(i)).Delete Next i Application.DisplayAlerts = True MsgBox "Empty worksheets deleted successfully.", vbInformation, "Delete Empty Worksheets" Else MsgBox "No worksheets were deleted.", vbInformation, "Delete Empty Worksheets" End If Else MsgBox "No empty worksheets found.", vbInformation, "Delete Empty Worksheets" End If End SubDetailed Explanation
This VBA macro scans through all worksheets in the active workbook and deletes those that are empty. Here’s a step-by-step breakdown of the code:
- Initialize Variables
- ws: Used to iterate through worksheets.
- wsCount: Stores the total number of worksheets.
- i: Loop counter.
- lastRow and lastCol: Identify the last used row and column.
- wsToDelete: A collection to store the names of empty worksheets.
- wsName: Stores worksheet names for confirmation.
- response: Captures user response in the confirmation message.
- Check If Only One Worksheet Exists
- If the workbook has only one worksheet, the macro displays a message and exits because deleting the last worksheet is not allowed.
- Loop Through All Worksheets
- The macro examines each worksheet to determine if it is empty.
- ws.Cells.Find(« * », SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row: Finds the last used row.
- ws.Cells.Find(« * », SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column: Finds the last used column.
- If both lastRow and lastCol are 1 and there are no non-empty cells (Application.WorksheetFunction.CountA(ws.Cells) = 0), the worksheet is considered empty.
- The empty worksheet’s name is stored in the wsToDelete collection.
- Confirm Deletion with the User
- If at least one empty worksheet is found, a message box lists the worksheets and asks the user for confirmation before proceeding.
- Delete Empty Worksheets
- If the user confirms, the macro:
- Temporarily disables Application.DisplayAlerts to suppress deletion warnings.
- Deletes each worksheet in the wsToDelete collection.
- Re-enables Application.DisplayAlerts.
- Displays a confirmation message.
- If the user confirms, the macro:
- Handle Cases Where No Empty Worksheets Are Found
- If no empty worksheets exist, the macro informs the user and exits.
Why This Code Is Effective?
✔ Prevents Deleting the Last Worksheet: Ensures that at least one worksheet remains.
✔ Accurate Detection of Empty Worksheets: Uses .Find and CountA functions to confirm emptiness.
✔ User Confirmation Before Deletion: Prevents accidental deletions.
✔ Batch Deletion Using a Collection: Improves efficiency by first identifying all empty sheets before deletion.
✔ Handles Alerts Properly: Prevents unnecessary warnings during deletion.- Initialize Variables
Delete Blank Rows With Excel VBA
VBA Code to Delete Blank Rows
Sub DeleteBlankRows() Dim ws As Worksheet Dim lastRow As Long Dim r As Long Dim rng As Range ' Set the active worksheet Set ws = ActiveSheet ' Find the last row with data in the worksheet lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Loop from the last row to the first row (to avoid skipping rows) For r = lastRow To 1 Step -1 ' Check if the entire row is empty If Application.WorksheetFunction.CountA(ws.Rows(r)) = 0 Then ws.Rows(r).Delete End If Next r ' Release memory Set ws = Nothing End Sub
Detailed Explanation of the Code
- Declaring Variables
Dim ws As Worksheet Dim lastRow As Long Dim r As Long Dim rng As Range
- ws: Stores the reference to the worksheet.
- lastRow: Stores the last used row in the worksheet.
- r: Used as a counter to iterate through rows.
- rng: (Not used in this example but can be useful for range selection).
- Assign the Active Worksheet
Set ws = ActiveSheet
- This assigns the currently active worksheet to the variable ws, ensuring we operate on the correct sheet.
- Find the Last Used Row
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
- ws.Rows.Count returns the total number of rows in the sheet (e.g., 1,048,576 for Excel 2007+).
- .End(xlUp) moves upwards from the last row in column A until it finds a non-empty cell.
- This technique effectively finds the last used row in the worksheet.
- Loop Through Rows (From Bottom to Top)
For r = lastRow To 1 Step -1
- We iterate backward from lastRow to row 1 (Step -1 ensures no row is skipped).
- If we looped from top to bottom, deleting rows would shift the row numbers, causing some blank rows to be missed.
- Check If the Row is Blank
If Application.WorksheetFunction.CountA(ws.Rows(r)) = 0 Then
- CountA(ws.Rows(r)) counts the number of non-empty cells in the entire row.
- If the result is 0, it means the row is completely empty.
- Delete the Blank Row
ws.Rows(r).Delete
- Deletes the entire row when it is found to be blank.
- Release Memory
Set ws = Nothing
- This is good practice to free up memory after executing the macro.
Alternative Approach Using AutoFilter
This method is faster for large datasets.
Sub DeleteBlankRowsWithFilter() Dim ws As Worksheet Dim rng As Range ' Set the worksheet Set ws = ActiveSheet ' Set the range covering all used rows On Error Resume Next Set rng = ws.UsedRange On Error GoTo 0 ' Check if the range is valid If Not rng Is Nothing Then ' Apply filter to find blank rows in column A (change as needed) rng.AutoFilter Field:=1, Criteria1:="=" ' Delete visible rows after filtering On Error Resume Next ws.Rows("2:" & ws.Rows.Count).SpecialCells(xlCellTypeVisible).Delete On Error GoTo 0 ' Turn off filter ws.AutoFilterMode = False End If ' Release memory Set ws = Nothing End SubAdvantages of AutoFilter Method
Faster on large datasets
Avoids looping through each row
Works efficiently with large spreadsheetsConclusion
- For small datasets, the first method (looping through rows) works well.
- For large datasets, the AutoFilter method is much faster and more efficient.
Date and Time Functions in Excel VBA
- Getting the Current Date and Time
1.1. Now Function
The Now function returns the current system date and time.
Sub ShowCurrentDateTime() MsgBox "Current Date and Time: " & Now End Sub
Use Case: Useful when logging events with timestamps.
1.2. Date Function
The Date function returns the current system date without the time.
Sub ShowCurrentDate() MsgBox "Today's Date: " & Date End Sub
Use Case: Useful when you only need the date portion.
1.3. Time Function
The Time function returns the current system time without the date.
Sub ShowCurrentTime() MsgBox "Current Time: " & Time End Sub
Use Case: Useful for time-sensitive operations.
- Extracting Date and Time Components
2.1. Year, Month, and Day Functions
These functions extract individual components from a given date.
Sub ExtractDateParts() Dim dt As Date dt = Now MsgBox "Year: " & Year(dt) & vbCrLf & _ "Month: " & Month(dt) & vbCrLf & _ "Day: " & Day(dt) End Sub
Use Case: Useful when you need to break down a date into its components.
2.2. Hour, Minute, and Second Functions
These functions extract time components.
Sub ExtractTimeParts() Dim dt As Date dt = Now MsgBox "Hour: " & Hour(dt) & vbCrLf & _ "Minute: " & Minute(dt) & vbCrLf & _ "Second: " & Second(dt) End Sub
Use Case: Useful in time calculations.
- Adding and Subtracting Dates and Times
3.1. DateAdd Function
The DateAdd function allows adding or subtracting a specific interval.
Sub AddSubtractDates() Dim dt As Date dt = Date MsgBox "Today: " & dt & vbCrLf & _ "Tomorrow: " & DateAdd("d", 1, dt) & vbCrLf & _ "Last Week: " & DateAdd("ww", -1, dt) End SubUse Case: Useful for scheduling and forecasting.
Intervals:
Interval Description « yyyy » Years « q » Quarters « m » Months « d » Days « h » Hours « n » Minutes « s » Seconds - Calculating Date Differences
4.1. DateDiff Function
The DateDiff function calculates the difference between two dates.
Sub CalculateDateDifference() Dim startDate As Date, endDate As Date startDate = #1/1/2024# endDate = Date MsgBox "Days Difference: " & DateDiff("d", startDate, endDate) & vbCrLf & _ "Months Difference: " & DateDiff("m", startDate, endDate) & vbCrLf & _ "Years Difference: " & DateDiff("yyyy", startDate, endDate) End SubUse Case: Useful for age calculations, project deadlines, etc.
- Formatting Dates and Times
5.1. Format Function
The Format function customizes the display of dates and times.
Sub FormatDateTime() Dim dt As Date dt = Now MsgBox "Full Date: " & Format(dt, "dddd, mmmm dd, yyyy") & vbCrLf & _ "Short Date: " & Format(dt, "mm/dd/yyyy") & vbCrLf & _ "Custom Time: " & Format(dt, "hh:mm AM/PM") End Sub
Use Case: Useful for creating user-friendly reports.
Common Formats:
Format Code Output Example « mm/dd/yyyy » 03/22/2025 « dddd, mmmm dd, yyyy » Saturday, March 22, 2025 « hh:mm:ss AM/PM » 08:45:30 AM - Checking if a Value is a Valid Date
6.1. IsDate Function
The IsDate function checks if a value is a valid date.
Sub CheckIfValidDate() Dim value1 As Variant, value2 As Variant value1 = "03/22/2025" value2 = "Hello" MsgBox "Is '" & value1 & "' a date? " & IsDate(value1) & vbCrLf & _ "Is '" & value2 & "' a date? " & IsDate(value2) End Sub
Use Case: Useful for validating user input.
- Converting Dates and Times
7.1. CDate Function
The CDate function converts a value into a date.
Sub ConvertToDate() Dim strDate As String strDate = "March 22, 2025" MsgBox "Converted Date: " & CDate(strDate) End Sub
Use Case: Useful when dealing with dates stored as text.
- Timer Function for Measuring Execution Time
The Timer function returns the number of seconds elapsed since midnight.
Sub MeasureExecutionTime() Dim startTime As Double, endTime As Double startTime = Timer ' Simulating a delay Application.Wait Now + TimeValue("00:00:02") endTime = Timer MsgBox "Execution Time: " & (endTime - startTime) & " seconds" End SubUse Case: Useful for performance testing.
- Pausing Code Execution
9.1. Sleep API
The Sleep function pauses execution for a specified number of milliseconds.
#If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long) #End If Sub PauseExecution() MsgBox "Pausing for 3 seconds..." Sleep 3000 MsgBox "Resumed!" End Sub
Use Case: Useful for automation that requires delays.
Conclusion
Excel VBA provides a powerful set of date and time functions to manipulate, format, and calculate date values. Understanding these functions allows you to automate complex time-based calculations efficiently.
Data Validation in Excel VBA
- Basics of Data Validation in Excel VBA
Data Validation rules restrict the type of data that can be entered in a cell. These rules include:
- Whole Number
- Decimal
- List
- Date
- Time
- Text Length
- Custom Formula
In VBA, Data Validation is controlled using the Validation object of the Range class.
- Syntax for Adding Data Validation in VBA
To apply data validation, we use:
Range(« A1 »).Validation.Add Type, AlertStyle, Operator, Formula1, Formula2
Where:
- Type: Specifies the type of validation (e.g., xlValidateWholeNumber, xlValidateList).
- AlertStyle: Defines the alert style (xlValidAlertStop, xlValidAlertWarning, xlValidAlertInformation).
- Operator: Specifies an operator for comparison (xlBetween, xlGreater, xlLess, etc.).
- Formula1: First parameter of validation (e.g., minimum value).
- Formula2: Second parameter (used for range-based validation).
- VBA Code Examples for Different Data Validation Types
3.1 Whole Number Validation (Between 1 and 100)
Sub ValidateWholeNumber() With Range("B2").Validation .Delete .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=1, Formula2:=100 .InputTitle = "Enter a Number" .ErrorTitle = "Invalid Entry" .InputMessage = "Please enter a whole number between 1 and 100." .ErrorMessage = "Only numbers between 1 and 100 are allowed." .ShowInput = True .ShowError = True End With End Sub- .Delete clears any existing validation before applying new rules.
- .InputTitle and .InputMessage provide guidance when the user selects the cell.
- .ErrorTitle and .ErrorMessage define what appears if validation fails.
3.2 Decimal Validation (Greater than 10.5)
-
Sub ValidateDecimal() With Range("C2").Validation .Delete .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, _ Operator:=xlGreater, Formula1:=10.5 .InputTitle = "Decimal Entry" .ErrorTitle = "Invalid Decimal" .InputMessage = "Enter a decimal greater than 10.5." .ErrorMessage = "Value must be greater than 10.5." End With End SubEnsures that only decimal numbers greater than 10.5 are allowed.
3.3 List Validation (Dropdown Menu)
Sub ValidateList() With Range("D2").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="Apple,Banana,Cherry" .InputTitle = "Select a Fruit" .ErrorTitle = "Invalid Choice" .InputMessage = "Choose a fruit from the dropdown list." .ErrorMessage = "Only Apple, Banana, or Cherry are allowed." End With End Sub- Creates a dropdown list with predefined values.
3.4 Date Validation (Between Two Dates)
Sub ValidateDate() With Range("E2").Validation .Delete .Add Type:=xlValidateDate, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="01/01/2023", Formula2:="12/31/2023" .InputTitle = "Enter a Date" .ErrorTitle = "Invalid Date" .InputMessage = "Enter a date between 01/01/2023 and 12/31/2023." .ErrorMessage = "Date must be between the specified range." End With End Sub- Ensures that the entered date is within the specified range.
3.5 Custom Formula Validation (Only Even Numbers)
Sub ValidateCustomFormula() With Range("F2").Validation .Delete .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, _ Formula1:="=MOD(F2,2)=0" .InputTitle = "Even Numbers Only" .ErrorTitle = "Invalid Entry" .InputMessage = "Please enter an even number." .ErrorMessage = "Only even numbers are allowed." End With End Sub- Uses a custom formula to allow only even numbers.
- Clearing Data Validation in VBA
To remove validation from a specific range:
Sub ClearValidation() Range("A1:F10").Validation.Delete End SubTo clear validation from the entire worksheet:
Sub ClearAllValidation() Dim ws As Worksheet Set ws = ActiveSheet ws.Cells.Validation.Delete End Sub
- Checking If a Cell Has Data Validation
To check if a cell has validation:
Sub CheckValidation() If Range("A1").Validation.Type <> xlValidAlertStop Then MsgBox "Data Validation is applied.", vbInformation, "Validation Check" Else MsgBox "No Data Validation found.", vbExclamation, "Validation Check" End If End Sub- Applying Data Validation to a Dynamic Range
This example applies a dropdown list validation to a dynamic range:
-
Sub DynamicValidation() Dim lastRow As Long lastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Find last used row in column A With Range("B2:B" & lastRow).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Formula1:="Apple,Banana,Cherry" .InputMessage = "Select a fruit." .ErrorMessage = "Invalid selection!" End With End SubAutomatically detects the last row and applies validation dynamically.
7. Using Named Ranges in Data Validation
To use a named range in list validation:
Sub ValidateNamedRange() With Range("G2").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Formula1:="=FruitList" ' FruitList is a named range .InputTitle = "Select a Fruit" .InputMessage = "Choose a fruit from the list." End With End SubMake sure « FruitList » is a named range containing values.
Conclusion
VBA makes it easy to automate Data Validation in Excel, ensuring accurate data entry and enhancing user experience. You can:
✔ Apply different types of validation
✔ Use dynamic ranges for scalability
✔ Customize error and input messages
✔ Use formulas for advanced validationCreate Sudoku Solver with Excel VBA
Creating a Sudoku Solver in Excel using VBA is a great way to practice algorithm design and automation. Here’s a detailed breakdown of how to build the solver in Excel VBA:
Overview:
The Sudoku puzzle consists of a 9×9 grid, where some cells are pre-filled with numbers, and others are empty (represented by zeroes or blanks). The solver will try to fill the empty cells by following these rules:
- Each row must contain the numbers 1 to 9 without repetition.
- Each column must contain the numbers 1 to 9 without repetition.
- Each of the nine 3×3 sub-grids must contain the numbers 1 to 9 without repetition.
The VBA code will employ a backtracking algorithm to solve the puzzle, trying different numbers for empty cells and backtracking if it reaches an invalid state.
Steps to Implement the Solver in VBA:
- Prepare the Worksheet
In your Excel worksheet, set up a 9×9 grid where the Sudoku puzzle will be displayed. You can represent the puzzle using a simple range like A1:I9, where each cell corresponds to a number in the puzzle.
- Open the VBA Editor
Press Alt + F11 to open the Visual Basic for Applications (VBA) editor. In the editor, go to Insert → Module to create a new module where you will paste the VBA code.
- Write the Sudoku Solver Code
Here’s the detailed VBA code for the Sudoku Solver using a backtracking algorithm:
Sub SolveSudoku() ' Define variables Dim sudoku(1 To 9, 1 To 9) As Integer Dim row As Integer, col As Integer Dim i As Integer, j As Integer ' Read the Sudoku puzzle from the worksheet into the sudoku array For row = 1 To 9 For col = 1 To 9 sudoku(row, col) = Cells(row, col).Value Next col Next row ' Call the recursive solver function If Solve(sudoku) Then ' Write the solved Sudoku puzzle back to the worksheet For row = 1 To 9 For col = 1 To 9 Cells(row, col).Value = sudoku(row, col) Next col Next row MsgBox "Sudoku Solved!" Else MsgBox "No solution exists." End If End Sub Function Solve(ByRef sudoku() As Integer) As Boolean ' This function attempts to solve the Sudoku using a backtracking algorithm Dim row As Integer, col As Integer Dim num As Integer ' Find the next empty cell (0 represents an empty cell) If Not FindEmptyCell(sudoku, row, col) Then ' No empty cell found, puzzle is solved Solve = True Exit Function End If ' Try all numbers from 1 to 9 For num = 1 To 9 ' Check if the number is valid for this cell If IsValid(sudoku, row, col, num) Then ' Assign the number to the cell sudoku(row, col) = num ' Recursively attempt to solve the rest of the puzzle If Solve(sudoku) Then Solve = True Exit Function End If ' Backtrack if no solution was found sudoku(row, col) = 0 End If Next num ' No valid number was found, backtrack Solve = False End Function Function FindEmptyCell(ByRef sudoku() As Integer, ByRef row As Integer, ByRef col As Integer) As Boolean ' This function finds the next empty cell in the Sudoku puzzle (represented by 0) For row = 1 To 9 For col = 1 To 9 If sudoku(row, col) = 0 Then FindEmptyCell = True Exit Function End If Next col Next row FindEmptyCell = False End Function Function IsValid(ByRef sudoku() As Integer, row As Integer, col As Integer, num As Integer) As Boolean ' This function checks if a number is valid for a given cell (row, col) in the Sudoku puzzle ' Check if the number already exists in the row Dim i As Integer For i = 1 To 9 If sudoku(row, i) = num Then IsValid = False Exit Function End If Next i ' Check if the number already exists in the column For i = 1 To 9 If sudoku(i, col) = num Then IsValid = False Exit Function End If Next i ' Check if the number already exists in the 3x3 subgrid Dim startRow As Integer, startCol As Integer startRow = Int((row - 1) / 3) * 3 + 1 startCol = Int((col - 1) / 3) * 3 + 1 For i = startRow To startRow + 2 For j = startCol To startCol + 2 If sudoku(i, j) = num Then IsValid = False Exit Function End If Next j Next i ' The number is valid if it isn't in the row, column, or subgrid IsValid = True End Function
Explanation of the Code:
- Sub SolveSudoku: This is the main subroutine that reads the Sudoku puzzle from the Excel worksheet, calls the recursive Solve function, and then writes the solved puzzle back to the worksheet.
- Function Solve: This is the recursive backtracking function that solves the Sudoku puzzle. It tries to fill the empty cells one by one by placing numbers 1-9 and checking if they are valid. If a number leads to an invalid state, it backtracks (removes the number and tries the next one).
- Function FindEmptyCell: This function searches for the next empty cell (0) in the puzzle. It returns True if an empty cell is found, and False if the puzzle is completely filled.
- Function IsValid: This function checks if placing a given number in a specific cell is valid. It checks the row, column, and 3×3 subgrid to ensure no duplicates.
- Using the Solver:
- Enter your Sudoku puzzle in the range A1:I9 (9×9 grid). Use 0 or leave the cells empty for the puzzle’s blanks.
- Run the macro by pressing Alt + F8, selecting SolveSudoku, and clicking Run.
- The solver will fill in the grid and display a message box when the puzzle is solved or if no solution exists.
- Handling Edge Cases:
- If the puzzle has no solution (e.g., due to an invalid initial configuration), the solver will display a message saying « No solution exists. »
- Ensure that the input puzzle follows the basic rules of Sudoku to avoid inconsistencies or invalid states.
Conclusion:
This code utilizes the backtracking algorithm, a common approach to solving constraint satisfaction problems like Sudoku. It systematically tries potential solutions, backtracking when it encounters an invalid state, until it finds a valid solution or concludes that no solution exists.
Create Sudoku Puzzle with Excel VBA
- Set Up the Excel Sheet:
Before you start the VBA code, you should create a grid in Excel that represents the Sudoku board. You can do this by selecting a 9×9 range of cells (for example, A1:I9).
- VBA Code to Generate a Sudoku Puzzle:
Option Explicit Dim SudokuGrid(1 To 9, 1 To 9) As Integer Dim SolvedGrid(1 To 9, 1 To 9) As Integer Sub GenerateSudokuPuzzle() Dim i As Integer, j As Integer ' Initialize the Sudoku grid Call GenerateSolution ' Remove some numbers to create the puzzle Call RemoveNumbers ' Display the puzzle in the Excel grid Call DisplayPuzzle End Sub Sub GenerateSolution() ' Fill the grid with a valid Sudoku solution Call FillGrid(1, 1) End Sub Function FillGrid(Row As Integer, Col As Integer) As Boolean Dim num As Integer If Row > 9 Then FillGrid = True Exit Function End If If Col > 9 Then FillGrid = FillGrid(Row + 1, 1) Exit Function End If If SudokuGrid(Row, Col) > 0 Then FillGrid = FillGrid(Row, Col + 1) Exit Function End If For num = 1 To 9 If IsSafeToPlace(Row, Col, num) Then SudokuGrid(Row, Col) = num If FillGrid(Row, Col + 1) Then FillGrid = True Exit Function End If SudokuGrid(Row, Col) = 0 End If Next num FillGrid = False End Function Function IsSafeToPlace(Row As Integer, Col As Integer, num As Integer) As Boolean ' Check if the number can be placed in the specified position Dim i As Integer, j As Integer ' Check the row For i = 1 To 9 If SudokuGrid(Row, i) = num Then IsSafeToPlace = False Exit Function End If Next i ' Check the column For i = 1 To 9 If SudokuGrid(i, Col) = num Then IsSafeToPlace = False Exit Function End If Next i ' Check the 3x3 box Dim startRow As Integer, startCol As Integer startRow = (Row - 1) \ 3 * 3 + 1 startCol = (Col - 1) \ 3 * 3 + 1 For i = startRow To startRow + 2 For j = startCol To startCol + 2 If SudokuGrid(i, j) = num Then IsSafeToPlace = False Exit Function End If Next j Next i IsSafeToPlace = True End Function Sub RemoveNumbers() Dim removed As Integer removed = 0 Dim i As Integer, j As Integer Dim index As Integer Dim numbers(81) As Integer For i = 1 To 81 numbers(i) = i Next i ' Shuffle numbers array For i = 1 To 81 index = Int((81 - 1 + 1) * Rnd + 1) Dim temp As Integer temp = numbers(i) numbers(i) = numbers(index) numbers(index) = temp Next i ' Remove numbers to create the puzzle For i = 1 To 81 Dim row As Integer, col As Integer row = (numbers(i) - 1) \ 9 + 1 col = (numbers(i) - 1) Mod 9 + 1 If SudokuGrid(row, col) <> 0 Then SudokuGrid(row, col) = 0 removed = removed + 1 End If If removed >= 40 Then Exit For Next i End Sub Sub DisplayPuzzle() Dim row As Integer, col As Integer For row = 1 To 9 For col = 1 To 9 If SudokuGrid(row, col) > 0 Then Cells(row, col).Value = SudokuGrid(row, col) Else Cells(row, col).Value = "" End If Next col Next row End Sub
Explanation of the Code:
- Global Arrays (SudokuGrid, SolvedGrid):
- SudokuGrid: This is the array that holds the current state of the puzzle. It will be filled with numbers from 1 to 9 for the solution, and some numbers will be removed to create the puzzle.
- SolvedGrid: This array holds the full, completed Sudoku solution.
- Main Subroutine (GenerateSudokuPuzzle):
- This is the main subroutine that drives the generation of the Sudoku puzzle. It first calls GenerateSolution to create a valid solution, then it calls RemoveNumbers to remove some numbers from the grid to make it a puzzle, and finally, it displays the puzzle in the Excel worksheet using DisplayPuzzle.
- Generating the Solution (GenerateSolution):
- The GenerateSolution subroutine calls the FillGrid function, which is a recursive function that attempts to fill the grid with a valid solution.
- Filling the Grid (FillGrid):
- This function tries to fill the Sudoku grid row by row, column by column, and uses backtracking to find a valid configuration. If it encounters a situation where a number cannot be placed, it backtracks and tries another number.
- Safety Check (IsSafeToPlace):
- This function checks if placing a specific number in a given cell violates the Sudoku rules. It checks the current row, column, and the 3×3 subgrid to ensure the number doesn’t appear elsewhere.
- Removing Numbers (RemoveNumbers):
- After the grid has been filled with a valid solution, the RemoveNumbers subroutine randomly removes numbers from the grid to create the puzzle. It ensures that there are enough numbers removed (about 40 cells) to create a solvable puzzle.
- Displaying the Puzzle (DisplayPuzzle):
- This subroutine loops through the SudokuGrid and displays the numbers in the corresponding cells of the Excel sheet. If a cell contains a zero, it will display nothing.
How to Use the Code:
- Open your Excel workbook and press ALT + F11 to open the VBA editor.
- Insert a new module by clicking Insert > Module.
- Paste the entire code into the module.
- Close the VBA editor and return to your Excel workbook.
- Run the GenerateSudokuPuzzle macro by pressing ALT + F8, selecting GenerateSudokuPuzzle, and clicking « Run ».
This code will generate a random Sudoku puzzle every time it’s run, with some cells filled and others left empty. You can adjust the number of cells to remove by changing the condition in RemoveNumbers (currently set to remove 40 cells).
Create Stopwatch with Excel VBA
Step 1: Understanding the Requirements
A stopwatch in Excel should:
- Start counting time when triggered.
- Pause and resume when needed.
- Reset to zero.
- Display the elapsed time dynamically.
- Work without freezing Excel (using Application.OnTime instead of DoEvents).
Step 2: Creating the User Interface (UI)
Before writing the VBA code, let’s create a simple UI in an Excel worksheet:
- Insert Buttons (using Form Controls) and link them to the macro:
- Start Button (e.g., named « btnStart »)
- Pause Button (e.g., named « btnPause »)
- Reset Button (e.g., named « btnReset »)
- Designate a Cell for Display:
- Select a cell (e.g., B2) to display the elapsed time.
Step 3: Writing the VBA Code
Now, let’s write the VBA code for the stopwatch.
- Declare Variables
We need to track:
- The start time
- The elapsed time before pausing
- Whether the stopwatch is running
Option Explicit Dim startTime As Double Dim elapsedTime As Double Dim isRunning As Boolean Dim nextTick As Date
- Start Stopwatch
This macro initializes the stopwatch and begins updating the display every second.
Sub StartStopwatch() If Not isRunning Then ' Capture the start time if not already running startTime = Timer - elapsedTime isRunning = True UpdateTime End If End Sub
Explanation:
- If the stopwatch isn’t running, we capture the start time (Timer is the number of seconds since midnight).
- We subtract the previously recorded elapsedTime (to allow resuming).
- isRunning is set to True and we start updating the time.
- Update Displayed Time
This subroutine keeps updating the elapsed time.
Sub UpdateTime() If isRunning Then elapsedTime = Timer - startTime Sheet1.Range("B2").Value = Format(elapsedTime, "0.00") & " sec" ' Schedule the next update nextTick = Now + TimeValue("00:00:01") Application.OnTime nextTick, "UpdateTime" End If End SubExplanation:
- Calculates elapsed time dynamically.
- Updates the assigned cell (B2).
- Schedules itself to run again in 1 second using Application.OnTime.
- Pause Stopwatch
This macro stops the timer temporarily.
Sub PauseStopwatch() If isRunning Then isRunning = False Application.OnTime nextTick, "UpdateTime", , False End If End Sub
Explanation:
- Stops Application.OnTime, preventing further updates.
- Stores the elapsedTime so it can resume later.
- Reset Stopwatch
This resets everything to zero.
Sub ResetStopwatch() isRunning = False elapsedTime = 0 Sheet1.Range("B2").Value = "0.00 sec" Application.OnTime nextTick, "UpdateTime", , False End SubExplanation:
- Stops the stopwatch.
- Resets elapsedTime to zero.
- Clears the scheduled Application.OnTime events.
Step 4: Assign Macros to Buttons
- Right-click each button.
- Select « Assign Macro ».
- Link them as follows:
- « StartStopwatch » → Start Button
- « PauseStopwatch » → Pause Button
- « ResetStopwatch » → Reset Button
Step 5: Testing the Stopwatch
- Click Start → The time should begin updating.
- Click Pause → The time should stop but remain visible.
- Click Start again → The stopwatch should resume from where it stopped.
- Click Reset → The timer should reset to 0.
Final Notes
- Application.OnTime ensures Excel remains responsive.
- The format « 0.00 sec » makes the output readable.
- The logic supports pausing and resuming, unlike traditional DoEvents-based loops.
Create Waterfall Chart in Excel With VBA
A Waterfall Chart is used to visually illustrate cumulative effects of sequential positive and negative values, often for financial data like revenue, expenses, and net profit. Since Excel 2016 introduced a built-in Waterfall Chart, we will use VBA to create a Waterfall Chart dynamically for earlier Excel versions as well.
- Understanding the Waterfall Chart
A Waterfall Chart consists of:
- Starting Value: The first column (e.g., « Opening Balance »).
- Positive and Negative Changes: Columns representing increases (green) and decreases (red).
- Ending Value: The last column (e.g., « Closing Balance »).
- Bridges: The cumulative flow of values.
Since Excel does not provide built-in Waterfall Charts before Excel 2016, we will use Stacked Column Charts and format them manually.
- Data Structure for the Waterfall Chart
We need a structured dataset:
Category Value Base Increase Decrease Opening 5000 0 5000 0 Revenue 3000 5000 3000 0 Expenses -2000 8000 0 2000 Profit 4000 6000 4000 0 - Base Column: Helps position floating bars.
- Increase Column: Positive values.
- Decrease Column: Negative values converted to positive.
- VBA Code to Create the Waterfall Chart
This VBA macro:
- Reads data from an active worksheet.
- Processes data into the required format.
- Creates a stacked column chart.
- Applies colors for increases (green) and decreases (red).
- Removes the base series from visibility.
VBA Code
Sub CreateWaterfallChart() Dim ws As Worksheet Dim chartObj As ChartObject Dim chartWaterfall As Chart Dim lastRow As Long Dim rngCategory As Range, rngBase As Range, rngIncrease As Range, rngDecrease As Range ' Set the worksheet Set ws = ActiveSheet ' Find the last row of data lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Define data ranges Set rngCategory = ws.Range("A2:A" & lastRow) ' Categories Set rngBase = ws.Range("C2:C" & lastRow) ' Base values Set rngIncrease = ws.Range("D2:D" & lastRow) ' Increase Set rngDecrease = ws.Range("E2:E" & lastRow) ' Decrease ' Add a new chart Set chartObj = ws.ChartObjects.Add(Left:=300, Width:=500, Top:=50, Height:=350) Set chartWaterfall = chartObj.Chart ' Set chart type chartWaterfall.ChartType = xlColumnStacked ' Add series With chartWaterfall .SetSourceData Source:=Union(rngBase, rngIncrease, rngDecrease) ' Format Base Series (Make it invisible) With .SeriesCollection(1) .Format.Fill.Visible = msoFalse .Border.LineStyle = xlNone End With ' Format Increase Series (Green) With .SeriesCollection(2) .Format.Fill.ForeColor.RGB = RGB(0, 176, 80) ' Green End With ' Format Decrease Series (Red) With .SeriesCollection(3) .Format.Fill.ForeColor.RGB = RGB(192, 0, 0) ' Red End With ' Set Axis Titles .Axes(xlCategory).HasTitle = True .Axes(xlCategory).AxisTitle.Text = "Categories" .Axes(xlValue).HasTitle = True .Axes(xlValue).AxisTitle.Text = "Values" ' Chart title .HasTitle = True .ChartTitle.Text = "Waterfall Chart" End With ' Cleanup Set ws = Nothing Set chartObj = Nothing Set chartWaterfall = Nothing Set rngCategory = Nothing Set rngBase = Nothing Set rngIncrease = Nothing Set rngDecrease = Nothing MsgBox "Waterfall Chart Created Successfully!", vbInformation, "Success" End Sub- Explanation of the VBA Code
- Data Selection:
- The macro identifies the last row (lastRow) for dynamic range selection.
- It assigns each column (Categories, Base, Increase, Decrease) to a VBA Range variable.
- Chart Creation:
- Adds a new ChartObject to the active worksheet.
- Defines it as a Stacked Column Chart (xlColumnStacked).
- Series Formatting:
- Base Series (Series 1) is hidden to create the floating effect.
- Increase Series (Series 2) is set to Green (RGB(0, 176, 80)).
- Decrease Series (Series 3) is set to Red (RGB(192, 0, 0)).
- Axis and Titles:
- Labels the X-axis as « Categories » and the Y-axis as « Values ».
- Assigns the title « Waterfall Chart ».
- User Notification:
- Displays a message box confirming chart creation.
- How to Use the VBA Macro
- Open an Excel workbook and enter the data structure mentioned earlier.
- Press ALT + F11 to open the VBA Editor.
- Click Insert > Module and paste the VBA code.
- Run the macro by pressing F5 or from Developer > Macros > Run.
- Conclusion
This VBA macro dynamically creates a Waterfall Chart in Excel, making it useful for users who don’t have Excel 2016 or later. It ensures:
- Automatic formatting with green/red color-coding.
- Dynamic data handling.
- User-friendly execution via a macro.
Create UserForm in Excel VBA
- What is a UserForm?
A UserForm is a custom dialog box that allows users to interact with VBA applications in Excel. It provides a graphical interface to input and display data using controls like text boxes, labels, buttons, combo boxes, and list boxes.
- Steps to Create a UserForm in Excel VBA
Step 1: Open the VBA Editor
- Open Excel.
- Press ALT + F11 to open the VBA Editor.
- In the VBA Editor, go to Insert → UserForm.
A blank UserForm will appear along with the Toolbox, where you can add controls like text boxes, labels, buttons, etc.
Step 2: Add Controls to the UserForm
- Drag and drop the following controls onto the UserForm:
- Labels (for field names)
- TextBoxes (for user input)
- CommandButtons (for actions like Submit and Cancel)
- ComboBox (for selection options)
- ListBox (for multiple choices)
- Rename each control appropriately using the Properties Window.
Step 3: VBA Code to Handle UserForm Events
Below is the complete VBA code for a UserForm that collects user details (Name, Age, and Gender) and stores them in an Excel sheet.
Code: UserForm with Data Entry Functionality
' Define the UserForm and its components Option Explicit Private Sub UserForm_Initialize() ' Initialize the ComboBox with gender options Me.cboGender.AddItem "Male" Me.cboGender.AddItem "Female" Me.cboGender.AddItem "Other" End Sub
Private Sub cmdSubmit_Click() Dim ws As Worksheet Dim lastRow As Long ' Set the worksheet Set ws = ThisWorkbook.Sheets("UserData") ' Find the last empty row lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 ' Transfer data from the UserForm to the worksheet ws.Cells(lastRow, 1).Value = Me.txtName.Value ws.Cells(lastRow, 2).Value = Me.txtAge.Value ws.Cells(lastRow, 3).Value = Me.cboGender.Value ' Clear fields for new entry Me.txtName.Value = "" Me.txtAge.Value = "" Me.cboGender.Value = "" ' Inform user MsgBox "Data Submitted Successfully!", vbInformation, "Success" End SubPrivate Sub cmdCancel_Click() ' Close the UserForm Unload Me End Sub
- Explanation of the Code
- UserForm_Initialize()
- This event is triggered when the form loads.
- It populates the ComboBox (cboGender) with gender options.
- cmdSubmit_Click()
- Retrieves values from TextBoxes and ComboBox.
- Finds the next available row in the worksheet.
- Saves the user’s input in the UserData worksheet.
- Clears the input fields for new entries.
- Displays a confirmation message.
- cmdCancel_Click()
Run ShowUserForm from the Macro window (ALT + F8) or assign it to a button.Closes the UserForm when the Cancel button is clicked.
- How to Run the UserForm
- Ensure your Excel sheet has a worksheet named « UserData » with headers (Name, Age, Gender).
- Open the VBA Editor, go to Insert → Module, and add this macro:
-
-
- Sub ShowUserForm()
- Show
- End Sub
-
- Enhancements & Best Practices
- Input Validation: Add error handling to prevent empty fields.
- Database Storage: Store data in an external database (e.g., Access).
- UI Improvements: Use frames, colors, and formatting for better aesthetics.