Wednesday, December 30, 2015

How To Read Cell from a Closed Workbook


If we do it manually, we can do like image below



A12 is result from closed Workbook (BookToRead.xlsx)

If we do it with Macro:
A. Methode 1 ( with formula like do manually)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
Sub Button1_Click()
Dim Path As String

Path = ThisWorkbook.Path & "\"

For i = 1 To 10
    Range("B11").Offset(i, 0) = "='" & Path & "[BookToRead.xlsx]Sheet1'!$A$" & i
Next i

End Sub

B. Methode2 (with ExecuteExcel4Macro)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
Sub Button2_Click()
Dim i As Integer

Path = ThisWorkbook.Path & "\"

For i = 1 To 10
    Range("G11").Offset(i, 0) = ExecuteExcel4Macro("'" & Path & "[BookToRead.xlsx]Sheet1'!R" & i & "C1")
Next i

End Sub



Download File (Place both files in same directory)








How to Run a Macro from Other Workbook

Here the example.

Macro in Book2:

1
2
3
Sub MacroBook2()
MsgBox "This macro from book2"
End Sub

Macro in Book1, from this macro we call MacroBook2

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
Sub MacroBook1()

Dim DestWB As Excel.Workbook

Set DestWB = Workbooks.Open(ThisWorkbook.path & "\Book2.xlsm")

Application.Run "'" & DestWB.Name & "'!MacroBook2"

Set DestWB = Nothing

End Sub


Download File1 and File2 (Place both in same directory)















Monday, December 28, 2015

How to Copy Range and Paste in another Sheet's in VBA

This how to copy Range and Paste in another Sheet's in VBA

This simple!


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
Sub Button1_Click()

Worksheets("Sheet1").Range("A1:F1").Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A10:F10")

Worksheets("Sheet2").Activate

MsgBox "Finished"

End Sub



Download File

How to activate a specific worksheet in VBA

How to activate a specific worksheet in VBA.

Calling this method is equivalent to clicking the sheet's tab.


1
2
3
Sub Button1_Click()
   UserForm1.Show
End Sub


1
2
3
4
5
6
7
8
9
Private Sub UserForm_Initialize()
Dim ws As Worksheet

For Each ws In Worksheets
    UserForm1.ComboBox1.AddItem ws.Name
Next ws

UserForm1.ComboBox1.ListIndex = 0
End Sub


1
2
3
4
5
6
7
8
Private Sub CommandButton1_Click()
Dim tmp As String

tmp = UserForm1.ComboBox1.Value

Worksheets(tmp).Activate

End Sub




Downlod File


Saturday, December 26, 2015

How To Add Worksheet in VBA

Adding worksheets to Excel is very simple. For example, to add a Worksheet after the active sheet (default unless stated otherwise), name it "MySheet" and have it become the active sheet, you would use some code like shown below

1
2
3
Sub Simple1()
Worksheets.Add().Name = "MySheet"
End Sub

If we wanted to add a Worksheet as the last Worksheet and name it "MySheet" we would use


1
2
3
4
5
6
7
Sub Simple2()
    Dim ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        ws.Name = "MySheet2"
    End With
End Sub

And, below code use with checking sheet already exist or not.
If exist adding sheet will skip.


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Simple3()
    Dim ws As Worksheet
    Dim wsName As String
    Dim Flag As Boolean
    
    Flag = True
    wsName = "MySheet3"
    With ThisWorkbook
        For Each ws In Worksheets
            If ws.Name = wsName Then
                Flag = False
            End If
        Next ws
        If Flag Then
            Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ws.Name = wsName
            MsgBox wsName & " Sheet already created"
        Else
            MsgBox wsName & " Sheet already exist"
        End If
    End With
End Sub

Download File

How Changing color of tabs in Excel using VBA

This code will change all sheet tab color become red


1
2
3
4
5
6
7
8
Sub Sample1()
Dim Sht As Worksheet
For Each Sht In Application.Worksheets
    With Sht.Tab
        .ColorIndex = 3 'red color
    End With
Next Sht
End Sub

Below code use to change sheet tab color become default (no color).


1
2
3
4
5
6
7
8
Sub Sample2()
Dim Sht As Worksheet
For Each Sht In Application.Worksheets
    With Sht.Tab
        .ColorIndex = xlColorIndexNone 'no color
    End With
Next Sht
End Sub

And, below example code use to change tab color for Sheet1 and Sheet3 only.


1
2
3
4
5
6
7
8
Sub Sample3()
Dim SheetName As Variant

SheetName = Array("Sheet1", "Sheet3")
For i = LBound(SheetName) To UBound(SheetName)
    ActiveWorkbook.Sheets(SheetName(i)).Tab.ColorIndex = 3 'red color
Next
End Sub


Download File


Friday, December 25, 2015

How To get worksheet Name in VBA

How to get worksheet name in VBA


1
2
3
4
5
6
7
8
9
Sub Sample1()
    Dim ws As Worksheet, tmp As String
    For Each ws In Worksheets
        If ws.Name <> "" Then
            tmp = tmp & ws.Name & vbCrLf
        End If
    Next ws
    MsgBox tmp
End Sub


Below code, get worksheet name with count the sum of sheet first.


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
Sub Sample2()
    Dim ws As Worksheet, tmp As String
    Dim n As Integer, i As Integer
    
    n = ActiveWorkbook.Worksheets.Count ' there are 5 sheets
    
    For i = 1 To n
        tmp = tmp & Sheets(i).Name & vbCrLf
    Next i
    MsgBox tmp
End Sub

Below code, just get second sheet name


1
2
3
4
5
6
7
Sub Sample3()
    Dim tmp As String
    
    tmp = Sheets(2).Name 'just get second sheet name
    
    MsgBox tmp
End Sub

Download File



Workbook Open Check in VBA

Below code use to check a workbook is open or not?


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
Sub Sample01()
    Dim wb As Workbook, flag As Boolean
    For Each wb In Workbooks
        If wb.Name = "Book1.xlsm" Then flag = True
    Next wb
    If flag = True Then
        MsgBox "Book1 Open", vbInformation
    Else
        MsgBox "Book1 Not Open", vbInformation
    End If
End Sub

Above code  if Workbook name is BOOK1.xlsm


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
Sub Sample02()
    Dim wb As Workbook, flag As Boolean
    For Each wb In Workbooks
        If wb.Name = "BOOK1.xlsm" Then flag = True
    Next wb
    If flag = True Then
        MsgBox "Book1 Open", vbInformation
    Else
        MsgBox "Book1 Not Open", vbInformation
    End If
End Sub

But, that problem can solve easily with use UCASE or LCASE function.
UCASE function -> change string to Upper Case
LCASE function -> change string to Lower Case


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
Sub Sample03()
    Dim wb As Workbook, flag As Boolean
    For Each wb In Workbooks
        If UCase(wb.Name) = "BOOK1.XLSM" Then flag = True
    Next wb
    If flag = True Then
        MsgBox "Book1 Open", vbInformation
    Else
        MsgBox "Book1 Not Open", vbInformation
    End If
End Sub


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
Sub Sample04()
    Dim wb As Workbook, flag As Boolean
    For Each wb In Workbooks
        If LCase(wb.Name) = "book1.xlsm" Then flag = True
    Next wb
    If flag = True Then
        MsgBox "Book1 Open", vbInformation
    Else
        MsgBox "Book1 Not Open", vbInformation
    End If
End Sub

Download File



About Date on Cell VBA

Example1

1
2
3
Sub Button1_Click()
    MsgBox Range("B2").Value
End Sub


Example2

1
2
3
Sub Button2_Click()
    MsgBox Range("B9").Value & vbCrLf & Range("B9").Text
End Sub

Example3

1
2
3
Sub Button3_Click()
    MsgBox Range("B16").Value2 & vbCrLf & Range("B16").Text
End Sub
Example4

1
2
3
4
5
6
7
8
9
Sub Button4_Click()
    Dim FoundCell As Range
    Set FoundCell = Range("B25:B40").Find(What:="12/31/2015")
    If FoundCell Is Nothing Then
        MsgBox "Not Found"
    Else
        MsgBox FoundCell.Offset(0, 1)
    End If
End Sub

Example5
Below code will give output Not Found

1
2
3
4
5
6
7
8
9
Sub Button5_Click()
    Dim FoundCell As Range
    Set FoundCell = Range("B44:B59").Find(What:="12/31/2015", LookIn:=xlFormulas)
    If FoundCell Is Nothing Then
        MsgBox "Not Found"
    Else
        MsgBox FoundCell.Offset(0, 1)
    End If
End Sub

And, below code will get result "GGG"

1
2
3
4
5
6
7
8
9
Sub Button5a_Click()
    Dim FoundCell As Range
    Set FoundCell = Range("B44:B59").Find(What:="12/31/2015", LookIn:=xlValues)
    If FoundCell Is Nothing Then
        MsgBox "Not Found"
    Else
        MsgBox FoundCell.Offset(0, 1)
    End If
End Sub

Download File



Thursday, December 24, 2015

How to FindNext with VBA

If we want to find all A-0202 from image below,



1
2
3
4
5
6
Sub Sample1()
    Cells.Find(What:="A-0202", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
End Sub

Above code, could be simplified with:


1
2
3
4
5
6
7
8
Sub Sample2()
Dim Found As Range

Set Found = Cells.Find(What:="A-0202", After:=ActiveCell)
Found.Activate
Found = Cells.FindNext(After:=ActiveCell)

End Sub

But, how to find all A-0202 value in column B?
We can do like this


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Sample3()
Dim Found As Range
Dim FirstFound As Range
Dim tmp As String

Set Found = Cells.Find(What:="A-0202")

If Found Is Nothing Then
    MsgBox "Not Found"
    Exit Sub
Else
    Set FirstFound = Found
    tmp = "A-0202: " & Found.Offset(0, 1) & vbCrLf
End If

Do
    Set Found = Cells.FindNext(Found)
    If Found.Address = FirstFound.Address Then
        Exit Do
    Else
        tmp = tmp & "A-0202: " & Found.Offset(0, 1) & vbCrLf
    End If
Loop
MsgBox tmp
End Sub

And the result:

Download File





Wednesday, December 23, 2015

How to Cell Find with VBA

From image below, we want to find "Apple"
 With Find and Replace,


If we do it by Macro, can do like below code:


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
Sub Macro1()
'
' Macro1 Macro
'

'
    Cells.Find(What:="Apple", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
End Sub

Above code could be simplified, and we can also get value from next column.


1
2
3
4
5
Sub Sample1()
    Dim Target As Range
    Set Target = Cells.Find(What:="Apple")
    MsgBox "Value:" & Target.Offset(0, 1)
End Sub

Above code maybe only search from group 1, if we want to find from all group we can do like this


1
2
3
4
5
6
7
8
Sub Sample2()
    Dim Target As Range, msg As String
    Set Target = Range("A3:A8").Find(What:="Apple")
    msg = "Apple from group1:" & Target.Offset(0, 1) & vbCrLf
    Set Target = Range("C3:C8").Find(What:="Apple")
    msg = msg & "Apple from group2:" & Target.Offset(0, 1)
    MsgBox msg
End Sub

Download File

How to AutoFilter with VBA


AutoFilter provides us with a much faster alternative to loops of all kinds.

In the majority of cases it's faster and more efficient to use one of Excel's built in features as apposed to re-inventing the wheel with VBA code. This is why those that have learn Excel from the ground-up know what native features Excel has to offer. While those only familiar with VB/VBA tend to be the ones who re-invent the wheel.

Example 1


1
2
3
Sub Sample1()
    Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:="A"
End Sub


Sample1 Source could simplified with:


1
2
3
Sub Sample2()
    Range("A1").AutoFilter Field:=2, Criteria1:="A"
End Sub

Example 2



1
2
3
Sub Sample3()
    Range("A1").AutoFilter
End Sub


Example3


1
2
3
4
5
6
7
8
9
Sub Sample4()
    Dim myRange As AutoFilter
    Set myRange = ActiveSheet.AutoFilter
    If Not myRange Is Nothing Then
        MsgBox "Setting"
    Else
        MsgBox "Not Setting"
    End If
End Sub

Source in Example3 also can write with:


1
2
3
4
5
6
7
8
9
Sub Sample5()
    Dim myRange As AutoFilter
    Set myRange = ActiveSheet.AutoFilter
    If TypeName(myRange) = "AutoFilter" Then
        MsgBox "Setting"
    Else
        MsgBox "Not Setting"
    End If
End Sub


1
2
3
4
5
6
7
Sub Sample6()
    If ActiveSheet.AutoFilterMode Then
        MsgBox "Setting"
    Else
        MsgBox "Not Setting"
    End If
End Sub

Example4


1
2
3
4
5
6
7
Sub Sample7()
    Dim n As Long
    If ActiveSheet.AutoFilterMode Then
        n = ActiveSheet.AutoFilter.Filters.Count
        MsgBox n & " Filters"
    End If
End Sub

Example5



 1
 2
 3
 4
 5
 6
 7
 8
 9
10
Sub Sample8()
    Dim i As Long
    If ActiveSheet.AutoFilterMode Then
        For i = 1 To ActiveSheet.AutoFilter.Filters.Count
            If ActiveSheet.AutoFilter.Filters(i).On Then
                MsgBox i & " column as filter"
            End If
        Next i
    End If
End Sub

Example6


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
Sub Sample9()
    Dim i As Long, Title As String
    If ActiveSheet.AutoFilterMode Then
        For i = 1 To ActiveSheet.AutoFilter.Filters.Count
            If ActiveSheet.AutoFilter.Filters(i).On Then
                Title = ActiveSheet.AutoFilter.Range.Cells(1, i)
                MsgBox Title & " as the filter"
            End If
        Next i
    End If
End Sub

Download File





Tuesday, December 22, 2015

Create Border with VBA

With Macro Recorder:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub Macro1()
'
' Macro1 Macro
'

'
    Range("B2:C6").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

This source could be simplified with this


1
2
3
4
5
Sub Simplify()

Range("B12:C16").Borders.LineStyle = True

End Sub


Simple, isnt it?

Download File

Selection Operation on Cell

To operate the cell range selected by the user, use the Selection.

1
2
3
4
5
6
Sub Sample1()
    Dim c As Range
    For Each c In Selection
        c.Font.ColorIndex = 3
    Next c
End Sub

However, If selected object are graphs or text box, it will become an error when run in this macro. Because Selection is not a Range object

It is a trouble if you don't know what you are selected. So for the safe, instead use Selection, let use RangeSelection.

1
2
3
4
5
6
Sub Sample2()
    Dim c As Range
    For Each c In ActiveWindow.RangeSelection
        c.Font.ColorIndex = 3
    Next c
End Sub

RangeSelection is a property of the Window object. Difference selection, even  the selected object are a graph, it will return a range of cells that had been selected before.

Download File

Monday, December 21, 2015

How To Create Drop List di Excel

How to create drop list in excel

A. Methode 1

1. Click cell target
2. Click Data > Data Validation.
3. In Validation Criteria, choose list and input the "option" on Source , current we use Yes/No
4. Left Ignore Blank and In-cell dropdown cheked,
5. On  Error Alert tab, On Check list Show Error Alert After Invalid Data is Entered.
    - if Cheked, only allowed Yes or No
    - if Not Checked, it wil be alowed except Yes or No
6. Click OK

B. Methode 2
1. Make a list of option in some cells, example: Apple, Mangga, Pisang, Duren
2. Select the cells that contains the option.
3. Klik Data >  Data Validation
4. Validation Criteria, choose list and select source data
5. click OK


RAND function

This article describes the formula syntax and usage of the RAND function in Microsoft Excel.

Syntax: RAND()

Returns an evenly distributed random real number greater than or equal to 0 and less than 1. A new random real number is returned every time the worksheet is calculated.


Note: When a worksheet is recalculated by entering a formula or data in a different cell, or by manually recalculating (press F9), a new random number is generated for any formula that uses the RAND function.

Download file