Private Sub Click_Button1()
Dim i As Integer
For i = 1 To 10
Cells(i, 1).Value = i
Next
End Sub
The VBA program will fill
Cells(1,1) with the value of 1,
Cells(2,1) with the value of 2,
Cells(3,1) with the value of 3......until cells (10,1) with the value of 10.
For loop with Step increment
Private Sub Click_Button1()
Dim i As Integer
For i = 1 To 10 Step 2
Cells (i, 1).Value = i
Next
End Sub
For Loop exit after certain condition fulfilled
Sub Button1_Click()
Dim i As Integer
For i = 1 To 15
Cells (i, 1).Value = i
If i >= 8 Then Here For loop is initialized for 1 to
Exit For 15 but this For loop will exit after 8
End If as mentioned in IF Condition
Next i
End Sub
NESTED Loop
Sub Sheet3_Button1_Click()
Dim i, j As Integer
For i = 1 To 10
For j = 1 To 5
Cells(i, j).Value = i + j
Next j
Next i
End Sub
In this example, when i=1, the value of j will iterate from 1 to 5 before it goes to the
next value of i, where j will iterate from I to 5 again.
The loops will end when i=10 and j=5.
[ i Row & j Column ]
For loop & If Else condition together
Sub Sheet4_Button1_Click()
Dim i, pass As Integer
For i = 1 To 12
If Cells (i, 2).Value > 60 Then
pass = pass + 1
Cells (i, 2).Font.ColorIndex = 5
Else
'do nothing
Cells (i, 2).Font.ColorIndex = 3
End If
Next i
Cells (13, 2).Value = pass
Cells (14, 2).Value = 12 - pass
End Sub
Remove duplicate numbers from array
i j
1 Unique num
Private Sub CommandButton2_Click()
Dim toAdd As Boolean, uniqueNumbers As Integer, i As Integer, j As Integer
Cells (1, 2).Value = Cells (1, 1).Value
uniqueNumbers = 1
toAdd = True
For i = 2 To 10
For j = 1 To uniqueNumbers Compare
Column A &
If Cells (i, 1).Value = Cells (j, 2).Value Then
Column B
toAdd = False
End If
Next j
If toAdd = True Then
Cells (uniqueNumbers + 1, 2).Value = Cells (i, 1).Value
uniqueNumbers = uniqueNumbers + 1
End If
toAdd = True
Next i
End Sub
i Unique num
String Manipulation
Sub Button_Click()
Dim string1 As String
Dim string2 As String
string1 = Range("B3").Value
string2 = Range("C3").Value
MsgBox string1 & " " & string2
End Sub
Source Data
Business Actual Budget
Company Unit Revenue Revenue Variance
4 Entity A BU_1 10,200 10,404 -2%
5 Entity B BU_1 12,240 12,485 -2%
6 Entity C BU_1 14,688 14,982 -2%
7 Entity D BU_1 19,776 17,978 10%
8 Entity E BU_2 10,300 10,506 -2%
9 Entity F BU_2 12,360 12,607 -2%
10 Entity E BU_2 10,300 10,506 -2%
11 Entity F BU_2 12,360 12,607 -2%
Now copy it with COPY Method
Destination (With Copy Method)
Range("A4:F11").Copy Range("I4")
This method will copy Source data (A4:E10) from I4
I J K L M
Business Actual Budget
Company Unit Revenue Revenue Variance
4 Entity A BU_1 10,200 10,404 -2%
5 Entity B BU_1 12,240 12,485 -2%
6 Entity C BU_1 14,688 14,982 -2%
7 Entity D BU_1 19,776 17,978 10%
8 Entity E BU_2 10,300 10,506 -2%
9 Entity F BU_2 12,360 12,607 -2%
10 Entity E BU_2 10,300 10,506 -2%
11 Entity F BU_2 12,360 12,607 -2%
Source Data
Business Actual Budget
Company Unit Revenue Revenue Variance
4 Entity A BU_1 10,200 10,404 -2%
5 Entity B BU_1 12,240 12,485 -2%
6 Entity C BU_1 14,688 14,982 -2%
7 Entity D BU_1 19,776 17,978 10%
8 Entity E BU_2 10,300 10,506 -2%
9 Entity F BU_2 12,360 12,607 -2%
10 Entity E BU_2 10,300 10,506 -2%
11 Entity F BU_2 12,360 12,607 -2%
12 Entity G BU_2 14,420 14,708 -2%
13 Entity H BU_2 16,480 16,810 -2%
(Here dynamically 2 new Rows have been added)
Destination (With Copy Method)
Range("A4").CurrentRegion.Copy Range("I4")
This method will copy Source data by Current Region so
if we add any Rows/Columns it will dynamically paste
that data into destination
I J K L M
Business Actual Budget
Company Unit Revenue Revenue Variance
4 Entity A BU_1 10,200 10,404 -2%
5 Entity B BU_1 12,240 12,485 -2%
6 Entity C BU_1 14,688 14,982 -2%
7 Entity D BU_1 19,776 17,978 10%
8 Entity E BU_2 10,300 10,506 -2%
9 Entity F BU_2 12,360 12,607 -2%
1
0 Entity E BU_2 10,300 10,506 -2%
1
1 Entity F BU_2 12,360 12,607 -2%
1
2 Entity G BU_2 14,420 14,708 -2%
1
3 Entity H BU_2 16,480 16,810 -2%
Referencing Worksheet
We need to copy marked data from Sheet5 to Sheet6
Sheet5.Range("A4").CurrentRegion.Copy Sheet6.Range("A4")
Send an email of Workbook
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'SET Outlook APPLICATION OBJECT.
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
'CREATE EMAIL OBJECT.
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
With objEmail
.to = "webadmin@encodedna.com"
.Subject = "This is a test message from Arun"
.Body = "Hi there"
.Send ' SEND THE MESSAGE.
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Export Multiple Charts from Excel Worksheet to PowerPoint using VBA
A PowerPoint (or PPT) presentation usually consists of many slides that show
various types of data. The slides can have images, texts, art clips, videos etc. You
can also show charts in the slides, imported from various sources, like an Excel
worksheet.
You can copy and paste the charts to your PPT slides. However, if you have multiple
charts across multiple worksheets in Excel, you can efficiently export all charts (or
specific charts) in PPT, with the click of a button.
The Data for the Charts
I have some data in my Excel worksheet. The data is similar to one I have used in my
previous post. You can add more data.
I am creating multiple charts with the above data, dynamically using VBA.
You can create the charts, as you want.
The VBA Code
The procedure or code that exports these charts to PowerPoint is called when a user
clicks a button.
Therefore, insert an ActiveX button control in your worksheet.
Next, open the VBA editor.
To work with PowerPoint from Excel, you’ll have to first add a PowerPoint library
reference to your VBA application.
1) From the top menu in your VBA editor, choose Tools – References. It will open
the References dialog box.
2) In the dialog box, find Microsoft PowerPoint 12.0 Object Library and click OK. Or
any version, which is installed in your computer. See the image.
Since, I have added a button control in my worksheet, I’ll write the code to call a procedure
in the button’s click event.
Option Explicit
Private Sub CommandButton1_Click()
exportCharts2Ppt
End Sub
Sub exportCharts2Ppt()
' Create a PowerPoint application object.
Dim objPPT As PowerPoint.Application
Set objPPT = New PowerPoint.Application
objPPT.Visible = True ' Make the PPT visible.
objPPT.Activate
' Create a PowerPoint presentation object.
Dim objPptPre As PowerPoint.Presentation
Set objPptPre = objPPT.Presentations.Add
‘We’ll show different charts in different slides in our PowerPoint presentation.
‘Therefore, create an object for PPT slides.
Dim objPPTSlides As PowerPoint.Slide
Dim iNdx As Integer ' Index, or position of each slide.
iNdx = 1
Dim Chart As ChartObject
Dim WS As Worksheet
For Each WS In ActiveWorkbook.Worksheets ' Loop through all the worksheets.
For Each Chart In WS.ChartObjects ' Loop through all the Chart Objects.
objChart.Chart.ChartArea.Copy ' Copy all the charts to the Clipboard.
' Create a new slide with a blank layout.
Set objPPTSlides = objPptPre.Slides.Add(iNdx, ppLayoutBlank)
' Extract the chart from the Clipboad and paste it.
objPPTSlides.Shapes.PasteSpecial ppPasteDefault, msoTrue
iNdx = iNdx + 1 ' Increment the slide index (or position).
Next objChart
Next objWS
End Sub
Copy all sheets into a single Sheet
Option Explicit
Private Sub Workbook_Open()
Call copyAllSheetsToSheet1
End Sub
Call the Procedure using a Button
You can call the above procedure by clicking a button. Simply, add a button (an
ActiveX Control) in one of your active worksheet, and call the procedure from inside
the button's click event.
Sub copyAllSheetsToSheet1()
On Error GoTo ErrHandler
Dim myWs As Worksheet
For Each myWs In ThisWorkbook.Sheets
' IGNORE "Sheet1", SINCE DATA IS IN 2 AND 3.
If myWs.Name <> "Sheet1" Then
If myWs.Name = "Sheet2" Then
'READ DATA RANGE FROM SOURCE AND COPY IT TO ITS DESTINATION SHEET1
AND RANGE.
Sheets(myWs.Name).Range("A1:B10").Copy
Destination:=Sheets("Sheet1").Range("B1")
Else
Sheets(myWs.Name).Range("A1:B10").Copy
Destination:=Sheets("Sheet1").Range("D1")
End If
End If
Next
ErrHandler:
Debug.Print Err.Description
End Sub
