Visual Basic in Excel

file

open a file in read only mode


Dim sourceWorkbook As Workbook
                                    

                                    Workbooks.Open ("…"), ReadOnly:=True
                                    

                                    Set sourceWorkbook = ActiveWorkbook

close a file

sourceWorkbook.Close

display

hide a column

Columns("B:B").Hidden = True

cut ’n paste

to get the cut ’n paste status, test the value of Application.CutCopyMode:
False: not in Cut or Copy mode
xlCopy: in Copy mode
xlCut: in Cut mode
set Application.CutCopyMode to False or True to cancel the Cut or Copy mode and to suppress the selection mark
to paste only the values
masterSheet.Range("B1").PasteSpecial xlPasteValues

filter

ShowAllData works only when there is currently some filtering


If ActiveSheet.FilterMode Then
                                    

                                        ActiveSheet.ShowAllData
                                    

                                    End If

filter according to the values in column 10 (equal to 0) and 12 (equal to 1)


Range("A1:A1").AutoFilter Field:=10, Criteria1:="0"
                                    

                                    Range("A1:A1").AutoFilter Field:=12, Criteria1:="1"

filter empty values

Range("A1:A1").AutoFilter Field:=10, Criteria1:="="
filter non-empty values

Range("A1:A1").AutoFilter Field:=10, Criteria1:="<>"
filter values equal "foobar"

Range("A1:A1").AutoFilter Field:=10, Criteria1:="=foobar"
filter values non equal to "foobar"

Range("A1:A1").AutoFilter Field:=10, Criteria1:="<>foobar"

There is a bug with Criteria1:="<>3.2" which results into a filter which is "<>3,2" on a French Excel.
filter values containing "foobar"

Range("A1:A1").AutoFilter Field:=10, Criteria1:="=*foobar*"
filter values beginning with "foobar"

Range("A1:A1").AutoFilter Field:=10, Criteria1:="=foobar*"
filter values ending with "foobar"

Range("A1:A1").AutoFilter Field:=10, Criteria1:="=*foobar"
when filtering on a column containing a Boolean expression, the macro recorder generates

Range("A1:A1").AutoFilter Field:=10, Criteria1:="VRAI"

but this is incorrect
the correct code is

Range("A1:A1").AutoFilter Field:=10, Criteria1:=True
remove the filter

Range("A1:A1").AutoFilter Field:=10

combination of two filters

Range("A1:A1").AutoFilter Field:=22, Criteria1:=">=12/09/2005", Operator:=xlAnd, Criteria2:="<=25/10/2005"

loop on the filtered data


For Each r In Sheets("summary").AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows
                                    

                                        Print #1, r.Cells(1, 1) & "-" & r.Cells(1, 8) 
                                    

                                    Next r

sort

a simple example

Dim l_status, l_priority As Integer
                                    

                                    l_status = 4
                                    

                                    l_priority = 5
                                    

                                    … 
                                    

                                    Range("A:BA").Sort Key1:=Cells(1, l_priority), Order1:=xlAscending, _
                                    

                                        Key2:=Cells(1, l_status), Order2:=xlDescending, _
                                    

                                        Header:=xlYes

navigation

SpecialCells(xlLastCell) returns sometimes an incorrect value (larger that the real last cell), use UsedRange to force a recomputation and get the right value.


ActiveSheet.UsedRange
                                    

                                    n = ActiveSheet.Cells.SpecialCells(xlLastCell).Row

sheets

create a temporary sheet and delete it without a confirmation message


Dim tempo As Worksheet
                                    

                                    Set tempo = Sheets.Add
                                    

                                    … 
                                    

                                    Application.DisplayAlerts = False
                                    

                                    tempo.Delete
                                    

                                    Application.DisplayAlerts = True

delete a sheet without an error if this one does not exist


Application.DisplayAlerts = False
                                    

                                    On Error Resume Next
                                    

                                    Sheets("foobar").Delete
                                    

                                    On Error GoTo 0
                                    

                                    Application.DisplayAlerts = True

change the name of the active sheet

ActiveSheet.Name = "foobar"
move a sheet to the first position

masterSheet.Move Before:=Sheets(1)

format

row height

For i = 2 To Sheets("summary").Cells.SpecialCells(xlCellTypeLastCell).Row
                                    

                                        Sheets("summary").Rows(i).RowHeight = 13
                                    

                                    Next i

column width

Columns("R:R").ColumnWidth = 10

text format

Rows("1:1").Orientation = 90
                                    

                                    Rows("1:1").HorizontalAlignment = xlLeft
                                    

                                    Rows("1:1").VerticalAlignment = xlBottom
                                    

                                    Rows("1:1").WrapText = True

filter

autofilter

Range("A1:P1").AutoFilter

values/formulas

use the Value property of a Range to define the values of some cells

For i = 2 To Sheets("imp").Cells.SpecialCells(xlCellTypeLastCell).Row
                                    

                                        Sheets("imp").Cells(i, 1).Value = "imp" & Sheets("imp").Cells(i, 2).Value
                                    

                                    Next i

For Each c in Worksheets("Sheet1").Range("A1:D10")
                                    

                                        If c.Value < .001 Then
                                    

                                            c.Value = 0
                                    

                                        End If
                                    

                                    Next c

When the cell contains multiple lines, these ones are separated by line feeds


Dim str() As String
                                    

                                    Dim i As Integer
                                    

                                    str = Split(report.Cells(line, col).Value, vbLf)
                                    

                                    For i = 0 To UBound(str)
                                    

                                        …
                                    

                                    Next i

Test if a cell is not empty


If (Not IsEmpty(stats.Cells(line, col).Value)) Then
                                    

                                        …
                                    

                                    End If

Text is a read-only property containing the value of the cell has a String.

`Formula`	define the formula of a cell
`FormulaLocal`	define the formula of a cell in the language of the user
`FormulaR1C1`	define the formula of a cell using R1C1 notation
`FormulaR1C1Local`	define the formula of a cell using R1C1 notation in the language of the user

Range("E18").FormulaR1C1 = "=OFFSET(R1C3,MATCH(16,R1C1:R20C1,0)-1,0)"

Range("E18").FormulaR1C1Local = "=DECALER(L1C3;EQUIV(16;L1C1:L20C1;0)-1;0)"

With a French Excel

Range("A1").FormulaR1C1 = "3.1"

set the cell's content to 3,1
use instead

Range("A1").FormulaR1C1Local = "3.1"

comment

macro to add or complete the comment of a cell

Private Sub addComment(rng As Range, str As String)
                                    

                                    
                                    

                                        If rng.Comment Is Nothing Then
                                    

                                            rng.addComment
                                    

                                        Else
                                    

                                            rng.Comment.Text rng.Comment.Text & vbLf
                                    

                                        End If
                                    

                                        rng.Comment.Text rng.Comment.Text & str
                                    

                                    
                                    

                                    End Sub

screen refresh

stop the automatic refresh of the screen

Application.ScreenUpdating = False
restart the automatic refresh of the screen

Application.ScreenUpdating = True
Application.ScreenRefresh does not exist (as in Word)

to have a faster macro execution, disable the formula updates (if adequate) during the macro run

Application.Calculation = xlCalculationManual
                                    

                                    …
                                    

                                    Application.Calculation = xlCalculationAutomatic

graphs

It seems that graphs must be fully set up before displaying them (by setting their Location), this should be verified…

Dim chart As Variant
                                    

                                    Set chart = Charts.Add
                                    

                                    chart.ChartType = xlColumnClustered
                                    

                                    chart.SetSourceData source:=Sheets("Root Cause Analysis").Range("A1:B13"), PlotBy:=xlRows
                                    

                                    chart.SeriesCollection(1).XValues = "='Root Cause Analysis'!R3C4:R7C4"
                                    

                                    chart.SeriesCollection(1).Values = "='Root Cause Analysis'!R3C5:R7C5"
                                    

                                    chart.HasLegend = False
                                    

                                    chart.HasDataTable = False
                                    

                                    chart.HasTitle = False
                                    

                                    chart.Location Where:=xlLocationAsObject, Name:="Root Cause Analysis"

pivot tables

use autofilter to filter the data (this one - 31 columns in sheet "summary" - must be copied in a new sheet in order to the pivot table to give the right results), then generate a pivot table of the number of bugs per bug types

Selection.AutoFilter Field:=11, Criteria1:="0"
                                    

                                    Selection.AutoFilter Field:=13, Criteria1:="1"
                                    

                                    
                                    

                                    Dim tempo As Worksheet
                                    

                                    Set tempo = Sheets.Add
                                    

                                    tempo.Name = "temp_extract"
                                    

                                    Sheets("summary").Range("A1").CurrentRegion.Copy
                                    

                                    Sheets("temp_extract").Paste
                                    

                                    Sheets("temp_extract").UsedRange
                                    

                                    
                                    

                                    Set tempo = Sheets.Add
                                    

                                    tempo.Name = "temp_table"
                                    

                                    
                                    

                                    Dim pcache As PivotCache
                                    

                                    Dim ptable As PivotTable
                                    

                                    Set pcache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="temp_extract!R1C1:R" & Sheets("temp_extract").Cells.SpecialCells(xlLastCell).Row & "C31")
                                    

                                    Set ptable = pcache.CreatePivotTable(TableDestination:="temp_table!R1C1", DefaultVersion:=xlPivotTableVersion10) 
                                    

                                    ptable.AddFields RowFields:="Tester"
                                    

                                    ptable.PivotFields("Tester").Orientation = xlDataField

another example with the same data, but here we are using also the columns and we order the rows and columns

Set pcache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="temp_extract!R1C1:R" & tempo1.Cells.SpecialCells(xlLastCell).Row & "C31")
                                    

                                    Set ptable = pcache.CreatePivotTable(TableDestination:=tempo2.Name & "!R1C1", DefaultVersion:=xlPivotTableVersion10)
                                    

                                    ptable.AddFields RowFields:="Severity", ColumnFields:="type"
                                    

                                    ptable.PivotFields("#").Orientation = xlDataField
                                    

                                    ptable.PivotFields("Severity").PivotItems("5").Position = 1
                                    

                                    ptable.PivotFields("Severity").PivotItems("4").Position = 2
                                    

                                    ptable.PivotFields("Severity").PivotItems("3").Position = 3
                                    

                                    ptable.PivotFields("Severity").PivotItems("2").Position = 4
                                    

                                    ptable.PivotFields("Severity").PivotItems("1").Position = 5
                                    

                                    ptable.PivotFields("type").PivotItems("soft").Position = 1
                                    

                                    ptable.PivotFields("type").PivotItems("template").Position = 2
                                    

                                    ptable.PivotFields("type").PivotItems("it").Position = 3
                                    

                                    ptable.PivotFields("type").PivotItems("doc").Position = 4

dump a pivot table in a HTML file

Print #1, "<TABLE border ='1'>"
                                    

                                    For n = ptable.TableRange1.Row To ptable.TableRange1.Rows.Count
                                    

                                        Print #1, "<TR>"
                                    

                                        For i = ptable.TableRange1.Column To ptable.TableRange1.Columns.Count
                                    

                                            Print #1, "<TD align='center' width='70'> & to_html(ActiveSheet.Cells(n, i)) & "</TD>"
                                    

                                        Next i
                                    

                                        Print #1, "</TR>"
                                    

                                    Next n
                                    

                                    Print #1, "</TABLE>"