How to create and format a workbook by VBA

Today I’d like to share with you some basic skills on manipulating Excel by VBA.

Create/Close/Delete a workbook

The best way of creating a new workbook is to use Add method to assign it to an object variable. Below is the full program and explanations demonstrating how to create the new workbook – ws.xls - and save it under E:\Example. Then the program also shows how to delete a workbook. Please note that workbook must be closed before it can be removed.

Sub Create_workbook() 'Create an object variable Dim wbk As Workbook 'Assign Workbook object to wkb Set wbk = Workbooks.Add 'Save fullname as a string variable wbkName = "E:\Example\Ws.xls" 'Save workbook with above fullname wbk.SaveAs wbkName 'Close the workbook wbk.Close 'Delete the workbook Kill wbkName End Sub

Return range reference (Address)

By Using Range.Address method, we can return a string value that represents range reference. Together with Mid function, we can even return column name. This is a very important skill which will be demonstrated in next part.

Sub Return_Address() '$A$1 MsgBox Worksheets(1).Cells(1, 1).Address 'Another way to return $A$1 Set mc = Worksheets(1).Cells(1, 1) MsgBox mc.Address '$A$1:$E$5 addr = Worksheets(1).Cells(1, 1).Address & ":" & Worksheets(1).Cells(5, 5).Address MsgBox addr 'Get Column Name For i = 6 To 9    addr = Cells(1, i).Address    colName = Mid(addr, 2, 1)    MsgBox colName Next i End Sub

Change RowHeight/ColumnWidth

Occasionally, length of values that we entered or pasted into cells is more than width. In this case, we need to adjust column width in order to see entire data. And sometimes, the data is too lengthy that we have to wrap it and change row height to see whole data. Following presents how to adjust Row Height or Column Width.

Sub Change_RowHeight() 'Changing the 4th row Height Rows(4).RowHeight = 30 'Changing height for multiple rows Rows("5:9").RowHeight = 2 'Another way to change height for multiple rows For i = 7 To 8  Rows(i).RowHeight = 10 Next i End Sub

Sub Change_ColumnWidth() 'Changing the 2nd column width Columns("B").ColumnWidth = 20 'Changing width for multiple columns Columns("C:E").ColumnWidth = 5 'Another way to change column width for multiple columns For i = 6 To 9   'Get Column Name    addr = Cells(1, i).Address    colName = Mid(addr, 2, 1)    If i = 6 Then       temp = colName    Else       temp = temp & "-" & colName    End If Next i faddr = Split(temp, "-")(0) & ":" & Split(temp, "-")(UBound(Split(temp, "-"))) Columns(faddr).ColumnWidth = 30 End Sub

Change Backgroundcolor

RGB(255,0,0) is for red, RGB(0,225,0) is for Green and RGB(0,0,255) is for blue.

Sub Change_Backgroundcolor() 'Example 1 Cells(1, 1).Interior.Color = RGB(255, 0, 0) Range("A2").Interior.Color = RGB(0, 0, 255) 'Example 2 For i = 4 To 9   If i Mod 2 <> 0 Then     For j = 1 To 9       Cells(i, j).Interior.Color = RGB(0, 225, 0)     Next j   End If Next i 'Example 3 - anther more efficient way to reset multiple cells For i = 4 To 9   If i Mod 2 = 0 Then      addr = Cells(i, 1).Address & ":" & Cells(i, 9).Address      Range(addr).Interior.Color = RGB(255, 0, 0)   End If Next i ‘Clear backgroundcolor Cells(1, 1).Interior.Color = xlnone End Sub

Modify font format(font style, bold, italicize, underline, color, size)

Sub Change_Font() 'Change font style Range("A1").Font.FontStyle = "Bold Italic" Cells(2, 1).Font.FontStyle = "Times New Roman" 'Change font to bold Range("A1").Font.Bold = True Cells(2, 1).Font.Bold = True 'Change font to Italic Range("A1").Font.Italic = True Cells(2, 1).Font.Italic = True 'Underline text Range("A1").Font.Underline = True Cells(2, 1).Font.Underline = True 'Change font color Range("A1").Font.Color = RGB(255, 0, 0) Cells(2, 1).Font.Color = RGB(0, 0, 255) 'Change font size Range("A1").Font.Size = 14 Cells(2, 1).Font.Size = 28 'Example For i = 4 To 9   If i Mod 2 = 0 Then      addr = Cells(i, 1).Address & ":" & Cells(i, 9).Address      Range(addr).Font.Color = RGB(0, 0, 255)   End If Next i End Sub

Change Cell border Style

Each range of cells can accept up to 8 different types of borders and borders means all borders around.

Left edge (xlEdgeLeft)

Top edge (xlEdgeTop)

Bottom edge (xlEdgeBottom)

Right edge (xlEdgeRight)

Inside vertical (xlInsideVertical)

Inside horizontal (xlInsideHorizontal)

Diagonal down (xlDiagonalDown)

Diagonal up (xlDiagonalUp)

 

Generally we’ve got 6 different kinds of border line style:

Continuous (xlContinuous)

Dot, (xlDot)

DashDotDot, (xlDashDotDot)

Dash, (xlDash)

SlantDashDot, (xlSlantDashDot)

Double, (xlDouble)

 

And there are 3 different border line thicknesses available:

Thin

Medium

Thick

Sub SetRangeBorder() 'Example 1  With Range("B2").Borders(xlEdgeBottom)     .LineStyle = xlContinuous     .Weight = xlThin     .Color = RGB(0, 0, 255)  End With 'Example 2  With Range("A4:E9").Borders     .LineStyle = xlDash     .Weight = xlThick End With 'Remove border Range("A4:E8").Borders.LineStyle = xlNone End Sub

Wrap text or change column width to get best fit

Sub text() ‘Wrap Text Range("A1").WrapText = True Cells(1, 1).WrapText = True ‘Autofit Range("A1:E1").Columns.AutoFit Columns("A:I").AutoFit End Sub

 

How to merge multiple worksheets into one worksheet horizontally or vertically via VBA

With the two macros described in this post, you will be able to combine multiple worksheets (of one workbook) into one (or master) worksheet. One macro is to copy data from different worksheets and paste them into one worksheet horizontally and the other one is to paste vertically.

First of all, below is the full program to merge different worksheets horizontally.

Sub Horizontal_Click() Application.DisplayAlerts = False 'Define variable Dim wbk As Workbook Dim ws As Worksheet 'Open workbook Set fnm = ThisWorkbook.Sheets(1).Cells(1, 2) Set wbk = Workbooks.Open(fnm) 'Set workbook as active workbook wbk.Activate 'Worksheets.count returns the number of worksheets For i = 1 To Worksheets.Count 'If there is a worksheet with name "Master" then delete this worksheet     If Worksheets(i).Name = "Master" Then         Worksheets(i).Delete     End If Next i 'Return number of all worksheet in the active workbook n = Worksheets.Count 'Add master worksheet after the last worksheet Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'Give the newly added worksheet a name ws.Name = "Master" a = 0 'loop through all worksheets For i = 1 To n 'Get the number of rows with data for each worksheet x = Worksheets(i).UsedRange.Rows.Count 'Return the number of columns with data for each worksheet y = Worksheets(i).UsedRange.Columns.Count 'loop through all cells in each worksheet For p = 1 To x  For q = 1 To y    b = a + q    'copy and paste    ws.Cells(p, b) = Worksheets(i).Cells(p, q)  Next q Next p a = a + y Next i 'Close workbook and save changes wbk.Save wbk.Close End Sub

And here is the code for how to merge vertically. This macro is more complex than the above one. But it is also not complicated. You can look into code in red or highlighted in yellow to figure out how it works.

Sub Vertical_Click() Application.DisplayAlerts = False 'Define variable Dim wbk As Workbook Dim ws As Worksheet 'Open workbook Set fnm = ThisWorkbook.Sheets(1).Cells(1, 2) Set wbk = Workbooks.Open(fnm) 'Set workbook as active workbook wbk.Activate 'Worksheets.count returns the number of worksheets For i = 1 To Worksheets.Count 'If there is a worksheet with name "Master" then delete this worksheet     If Worksheets(i).Name = "Master" Then         Worksheets(i).Delete     End If Next i 'Return number of all worksheet in the active workbook n = Worksheets.Count 'Add master worksheet after the last worksheet Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'Give the newly added worksheet a name ws.Name = "Master" a = 0 'loop through all worksheets For i = 1 To n 'Get the number of rows with data for each worksheet x = Worksheets(i).UsedRange.Rows.Count 'Return the number of columns with data for each worksheet y = Worksheets(i).UsedRange.Columns.Count 'Only the first row - column name - in the first worksheet will be kept, 'Otherwise, only data from the second row will be copied If i = 1 Then     For p = 1 To x      For q = 1 To y          b = a + p          ws.Cells(b, q) = Worksheets(i).Cells(p, q)      Next q     Next p ElseIf i > 1 Then     For p = 2 To x      For q = 1 To y          b = a + p          ws.Cells(b, q) = Worksheets(i).Cells(p, q)      Next q     Next p End If a = a + x - 1 Next i 'Close workbook and save changes wbk.Save wbk.Close End Sub

Only screenshot of combined worksheet in vertical way will be showed below. For the other case, you can run code and check by yourself.