Posts tagged: vba

Macro to sort sheets in a workbook

Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
   iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
     & "Clicking No will sort in Descending Order", _
     vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
   For i = 1 To Sheets.Count
      For j = 1 To Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
         If iAnswer = vbYes Then
            If UCase$(Sheets(j).Name)> UCase$(Sheets(j + 1).Name) Then
               Sheets(j).Move After:=Sheets(j + 1)
            End If
'
' If the answer is No, then sort in descending order.
'
         ElseIf iAnswer = vbNo Then
            If UCase$(Sheets(j).Name) <UCase$(Sheets(j + 1).Name) Then
               Sheets(j).Move After:=Sheets(j + 1)
            End If
         End If
      Next j
   Next i
End Sub

Update all pivot tables in a workbook

Option Explicit

Sub RefreshAllPivots()
Dim ws As Worksheet
Dim pt As PivotTable

On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
   For Each pt In ws.PivotTables
     pt.RefreshTable
   Next
Next
End Sub

Convert cell value to UPPERCASE or lowercase..

Select a range and run the macro. If no range is selected, the entire sheet is processed.

Sub UpperCase()
Dim cell As Excel.Range

For Each cell In Selection.SpecialCells(xlTextValues, 2)
    cell.Value = Ucase$(cell.Value)
Next cell

End Sub

Sub LowerCase()
Dim cell As Excel.Range

For Each cell In Selection.SpecialCells(xlTextValues, 2)
    cell.Value = Lcase$(cell.Value)
Next cell

End Sub

Source: http://www.codeforexcelandoutlook.com/blog/

Find circular references within your workbook

To use this macro, run the FindCircRefs macro from the Microsoft Excel worksheet for which you want to find circular references. A new sheet is added to the active workbook, listing the cell addresses of circular references in column A and the formula at that address in column B. If no circular references are found, the new sheet is empty.

Sub FindCircRefs()
       ' Get source information.
       sourcesheet = ActiveSheet.Name
       Sheets.Add
       ' Get destination information.
       destsheet = ActiveSheet.Name
       destrange = ActiveCell.Address
       ' Return to source.
       Worksheets(sourcesheet).Activate
       rowcount = 0
       ' Trap for error in "result", indicating no circular reference.
       On Error GoTo notcircular

       ' Loop through every used cell in source.
       For Each Item In ActiveSheet.UsedRange
           ' Check to see if cell contains a formula.
           If Left(Item.Formula, 1) = "=" Then
               ' If cell intersects with precedents, cell has circular
               ' reference.
               result = Intersect(ActiveSheet.Range(Item.Address), _
                   ActiveSheet.Range(Item.Precedents.Address))

               Worksheets(destsheet).Range(destrange).Offset(rowcount, _
                   0).Value = Item.Address(False, False)

               Worksheets(destsheet).Range(destrange).Offset(rowcount, _
                   1).Value = "'" & Item.Formula

               rowcount = rowcount + 1
               ' Skip to here if not circular.
   skipitem:
           End If
       Next
       Exit Sub

   ' If error in "result", go here.
   notcircular:
       ' Skip cells that do not contain circular references.
       Resume skipitem
   End Sub

Hide All But One Sheet

Hide All But One Sheet

Loop through all sheets in a Workbook and hide all but Sheet1. Excel will not allow all sheets hidden.

Sub HideAllButOneSheet()

'We must leave at least one Sheet visible

Dim wsSheet As Worksheet

    For Each wsSheet In Worksheets

       wsSheet.Visible = wsSheet.Name = "Sheet1"

    Next wsSheet

End Sub

VBA replace all blank cells within a range..

Sub ReplaceBlanks()

    'Set the range for which you want to fill the empty cells
    CellRange = "A1:D500"

    'Stop if all the cells are empty
    If WorksheetFunction.CountA(Range(CellRange)) = 0 Then

       MsgBox "All cells are empty", vbOKOnly

       Exit Sub

    End If
   
    'Replace the empty cells by the word "Blank"
    On Error Resume Next

    Range(CellRange).SpecialCells(xlCellTypeBlanks) = "Blank"

    On Error GoTo 0

End Sub

Use a defined name in your macro

I want my vba macro to refer to a name I defined in a worksheet within the current workbook:

'Define y as the value of a cell you have named NAME..
    Application.GoTo Reference:="NAME"
    y = ActiveCell.Value

'Define y as the row of a cell you have named NAME..
    Application.GoTo Reference:="NAME"
    y = ActiveCell.Row

'Define y as the column of a cell you have named NAME..
    Application.GoTo Reference:="NAME"
    y = ActiveCell.Column

Gather User Data/Input via an InputBox

There are many times in Excel VBA that we are required to gather information from a user. Probably the most frequent method of doing is via a message box, that is;

Sub UserInput()
Dim iReply As Integer
    iReply = MsgBox(Prompt:="Do you wish to run the 'update' Macro", _
            Buttons:=vbYesNoCancel, Title:="UPDATE MACRO")
    If iReply = vbYes Then
        Run "UpdateMacro"
    ElseIf iReply = vbNo Then
       'Do Other Stuff
    Else 'They cancelled (VbCancel)
        Exit Sub
    End If
End Sub

As you can though, the message box approach only allows for pre-determined responses. To actually allow the user to enter some text, number or even a formula we can use the InputBox Function. The syntax for the InputBox Function is;

InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])

It is rare that you will need to use [, xpos] [, ypos] or [, helpfile, context]. See Excel help for details on these. It should also be noted that, the InputBox Function returns a String only when used in this way. (more on another way soon).

Ok, lets assume we need to gather the name of the user and do some stuff depending on that name. The macro below will achieve this.

Sub GetUserName()
Dim strName As String
    strName = InputBox(Prompt:="You name please.", _
          Title:="ENTER YOUR NAME", Default:="Your Name here")
        If strName = "Your Name here" Or _
           strName = vbNullString Then
           Exit Sub
        Else
          Select Case strName
            Case "Bob"
                'Do Bobs stuff
            Case "Bill"
                'Do Bills stuff
            Case "Mary"
                'Do Marys stuff
            Case Else
                'Do other stuff
          End Select
        End If
End Sub

Note the use of the Select Case Statement to determine the name the user supplies.

Application.InputBox

When we precede the InputBox Function with "Application" we get an InputBox Method that will allow us to specify the type of info that we can collect. Its Syntax is;

InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)

As you can see, the Prompt, Title and Default are the same as in the InputBox Function. However, it is the last argument "Type" that allows us to specify the type of data we are going to collect. These are as shown below;

Type:=0 A formula
Type:=1 A number
Type:=2 Text (a string)
Type:=4 A logical value (True or False)
Type:=8 A cell reference, as a Range object
Type:=16 An error value, such as #N/A
Type:=64 An array of values

We have already covered a String being returned so lets look, what I believe, to be the most useful. That is, Type 8 & 1. The code below shows how we can allow the user to specify a Range Object.

Sub RangeDataType()
Dim rRange As Range
    On Error Resume Next
        Application.DisplayAlerts = False
            Set rRange = Application.InputBox(Prompt:= _
                "Please select a range with your Mouse to be bolded.", _
                    Title:="SPECIFY RANGE", Type:=8)
    On Error GoTo 0
        Application.DisplayAlerts = True
        If rRange Is Nothing Then
            Exit Sub
        Else
            rRange.Font.Bold = True
        End If
End Sub

Note the use of both, On Error Resume Next and Application.DisplayAlerts = False. These stop Excel from trying to handle any bad input from the user, or if they Cancel. Take the lines out, run the code and click Cancel, or specify a non valid range and Excel will bug out in the case of Cancel.

Let's now look at how we can collect a numeric value from a user.

Sub NumericDataType()
Dim lNum As Long
   On Error Resume Next
        Application.DisplayAlerts = False
            lNum = Application.InputBox _
             (Prompt:="Please enter you age.", _
                    Title:="HOW OLD ARE YOU", Type:=1)
    On Error GoTo 0
    Application.DisplayAlerts = True
        If lNum = 0 Then
           Exit Sub
        Else
            MsgBox "You are " & lNum & " years old."
        End If
 End Sub

Again, we take over the possibility of the user electing to Cancel, or entering a non-numeric value. If they enter anything that is not numeric and click OK, they are taken back to the InputBox Method with their entry highlighted.

Unlike the InputBox Function, we can combine different Types for the InputBox Method and take action based on their data type. See example.

Sub Numeric_RangeDataType()
Dim vData
    On Error Resume Next
        Application.DisplayAlerts = False
            vData = Application.InputBox _
             (Prompt:="Please select a single cell housing the number, " _
             & "or enter the number directly.", _
             Title:="HOW OLD ARE YOU", Type:=1 + 8)
     On Error GoTo 0
        Application.DisplayAlerts = True
    If IsNumeric(vData) And vData <> 0 Then
        MsgBox "You are " & vData & " years old."
    Else
       Exit Sub
    End If
End Sub