Cool Excel VBA trick: Write alphabets with Excel

Cool Excel VBA trick: Write alphabets with Excel

If  you've always wanted to create your very own alphabets, then this simple vba code will help you do that easily.

It uses a set of predetermined combination of pattern; you can create yourself or download a list of them from HERE.

See Example creating alphabets A,B,C D

And now the code: You can play with the code by changing any parameter that you want

Option Explicit Sub writing() Dim aCaps, a, b As Variant ' Create Your own alphabet patterns or download my pattern list below aCaps = Array(3, 4, 8, 11, 13, 18, 19, 20, 21, 22, 23, 24, 25, 30, 31, 36, 37, 42) a = Array(1, 2, 3, 4, 5, 6, 12, 13, 14, 15, 16, 17, 18, 19, 24, 25, 30, 31, 35, 36, 37, 38, 39, 40, 42) b = Array(1, 2, 3, 4, 5, 6, 7, 12, 13, 17, 18, 19, 20, 21, 22, 23, 25, 29, 30, 31, 36, 37, 38, 39, 40, 41, 42) 'This macro writes the alphabet you created above writeLetter (b) End Sub Sub writeLetter(alphabetPattern As Variant) 'initialize variable Dim cell As Range Dim counter AsInteger Dim i As Integer selectRange ' Macro to select a 7 x 6 Matrix of cells from the initial position counter = 1 'initialise counter 'Loop through the selection and color the require cells to draw the pattern ' Patterns comes from the writing macro as alphabetPattern For Each cell In Selection If counter <= Selection.Count Then For i = 0 To UBound(alphabetPattern) If counter = alphabetPattern(i) Then cell.RowHeight = 12 cell.ColumnWidth = cell.RowHeight / 6 cell.Interior.Color = vbBlack End If Next i End If counter = counter + 1 Next cell End Sub Sub selectRange() ' Simple macro to select a 7 x 6 matrix of cells Selection.Resize(1, 1).Select Selection.Resize(Selection.Rows.Count + 6, _ Selection.Columns.Count + 5).Select End Sub

How to create a Faster Lucas Number Function with VBA

Faster Lucas Number  Function in Excel

In mathematics, the sequence of number 2,1,3,4,7,11,18,29,47,76.... is known as the Lucas numbers or sequence. Read More Here

I would like to show you how to write faster Fibonacci generating function in excel

Open your visual basic editor and enter the following code. Visit this post to learn how to enable developer options in Excel

Learn how to create your own Excel Functions HERE

 
Option Explicit
' This set a maximum number for the sequence. 
' You can change it but use the right datatype
' learn Excel DataTypes HERE
Dim l(500) As Double
Function Lucas(n As Double) As Double
 If n = 1 Then
        Lucas = 2
    ElseIf n = 2 Then
        Lucas = 1
  ElseIf l(n) > 0 Then
        Lucas = l(n)
    Else
        l(n) = Lucas(n - 1) + Lucas(n - 2)
        Lucas = l(n)
    End If
End Function

Go to your Excel Workbook and use the function as follows

How to create a Faster Fibonacci Function in Excel with VBA

How to create a Faster Fibonacci  Function in Excel

In mathematics, the sequence of number 1,1,2,3,5,8,13,21,34,56.... is known as the Fibonacci numbers or sequence. Read More Here

I would like to show you how to write faster Fibonacci generating function in excel

Open your visual basic editor and enter the following code. Visit this post to learn how to enable developer options in Excel

Learn how to create your own Excel Functions HERE

 
Option Explicit
' This set a maximum number for the sequence. 
' You can change it but use the right datatype
' learn Excel DataTypes HERE
Dim f(500) As Double  

Function fib(n As Double)
 If n = 0 Or n = 1 Then
    fib = n
  ElseIf f(n) > 0 Then
        fib = f(n)
    Else
        f(n) = fib(n - 1) + fib(n - 2)
        fib = f(n)
    End If
End Function

Go to your Excel Workbook and use the function as follows

How to Delete Numeric Cells leaving Cells with Formulas with VBA

How to Delete Numeric Cells leaving Cells with Formulas with VBA

You want to delete all cell with numeric values but not those with formulas in them. This simple VBA snippet helps you to do so.

• Copy and Paste the code
• Select you Range of cell and RUN the Macro

 
Option Explicit  
  
Sub deleteNumeric()
Dim cell As Range
 For Each cell In Selection
    If IsNumeric(cell.Value) And cell.HasFormula = False Then
       cell.Clear
     End If
     
 Next cell
End Sub
    

How to Rename Workbook at the end of the Month with VBA

How to Rename Workbook at the end of the Month with VBA

Sometimes you want of quickly rename an excel file to some specific name. You may want to do this to save time.

There are many ways to achieve this; you can go through the normal everyday procedure:

• Look for file
• Right-click it and choose rename
• Rename it and
• Press Enter Key

Or you can just follow the step(s) below:

• While file is open, press a single button to rename

This code snippet is how you rename an excel file at the end of the month by adding the date to the name of the file.

Continue if you have enabled developer options

• Insert a new Module and enter the following codes

 
 Option Explicit   
  
 Private Sub RenameWorkbookAtMonthEnd()
 Dim wbName As String
 Dim dtMonth As Date
  wbName = ThisWorkbook.Name ' Get the Name of the workbook
  Call RenameWrkbk(wbName)   ' Pass wbName to sub to rename the Workbook
 End Sub

This first macro is used to first get the name of the workbook which is the passed to another macro to rename the file

 
Sub RenameWrkbk(wbName As String)
Dim day As String
day = Format(getNow, "dd") ' Get the day from the "getNow" function
    If day = "31" Or day = "30" Then  ' Verify for end of Month
    ThisWorkbook.SaveAs Filename:=getNewFileName(wbName),FileFormat:=ThisWorkbook.FileFormat            
    ' use the getNewFilename function to get a new name for the file
        Else: Exit Sub
        MsgBox "NOT END OF MONTH" ' Show Message box if it is not the end of the month
    End If
End Sub

This second macro is used to actually rename file with the getNewFileName() Function

 
Function getNewFileName(wbName As String) As String
    Dim fname As String
    Dim mntName As String
    fname = ""
    mntName = Format(getNow, "mmm-dd")
    fname = fname + Replace(wbName, ".xlsm", "") + mntName
    getNewFileName = fname
End Function
Function getNow() As Date
    getNow = Now()
End Function

Once done, you can either run the code directly or add it to a button

How to Create Sheets from Cell Selection with VBA

How to Create Sheets from Cell Selection with VBA

Creating and naming one excel sheet is simple and straight forward but creating about 100, 500 or even more is simple but tedious (VERY TEDIOUS).

Using VBA for excel, it is possible to rapidly create and name as many worksheets as you like. The following example is the use of Excel VBA to achieve this result

The solution below works in three simple steps:

• Run the code
• Select your range of cells including the empty cells
• Click OK to create and name your sheets with the names in the selection you made

Sample Screen Shots

• Example cell data       Empty cells with green background

• Run code and you get this asking you to select data range

• Finally Sheets are created ignoring empty cells

Now The VBA Code

First enable developer options if you haven't already done so.

Press Alt+F11 to open VBA editor

Then Copy and Paste the code below OR download the code file here 

 
Option Explicit  
   Sub cellToSheets()  
     Dim cell As Range  
     Dim i, K, counter As Integer  
     Dim nmActshet, emptyCells, cellNames() As String  
     Dim ws As Worksheet  
      On Error Resume Next  
      nmActshet = ActiveWorkbook.ActiveSheet.Name  
     Set cell = Application.InputBox(prompt:="Select Range", Type:=8) 
     cell.Select  
     K = 0  
     For i = 1 To cell.Count  
       If IsEmpty(cell(i)) = False Then  
        K = K + 1  
       End If  
     Next i  
     ReDim cellNames(K)  
     counter = 1  
     For i = 1 To cell.Count  
       If IsEmpty(cell(i)) = False Then  
         If cell(i).Value <> "" Then  
             cellNames(counter) = cell(i).Value  
             counter = counter + 1  
         End If  
       End If  
     Next i  
     counter = 1  
     For i = 1 To K  
       If verifySimilarSheetNames(cellNames(i)) = False Then  
           Set ws = ActiveWorkbook.Worksheets.Add(After:=Worksheets(ActiveWorkbook.Worksheets.Count))  
           ws.Name = cellNames(counter)  
           counter = counter + 1  
          Else  
             MsgBox "Similar sheet names exist"  
             Exit Sub  
       End If  
     Next i  
     ThisWorkbook.Worksheets(nmActshet).Activate  
   End Sub  
   Function verifySimilarSheetNames(ByVal cellValue As String) As Boolean  
     Dim status As Boolean  
     Dim sheetNames() As String  
     Dim mySheets As Sheets  
     Dim i As Integer  
       status = False  
     Set mySheets = ThisWorkbook.Worksheets  
     ReDim sheetNames(1 To mySheets.Count)  
     For i = 1 To mySheets.Count  
       sheetNames(i) = mySheets(i).Name  
     Next i  
       For i = 1 To UBound(sheetNames)  
         If cellValue = sheetNames(i) Then  
             status = True  
         End If  
       Next i  
     verifySimilarSheetNames = status  
   End Function  

Recommended Books

• Mastering VBA Excel for Office 2013
• VBA Developer Handbook
• Excel VBA Programming For Dummies 

How to Enable Developer Options in Excel

How to Enable Developer Options in Excel 

Follow the Pictures

• Step 1

• Step 2

• Step 3