Ashish Koul's blog

Show Country Flags as Markers on X Y Chart

If you want to display the country flags as markers on X Y Scatter Chart. Snapshot below:

Steps
1 Download the country flags and save them in a folder
2 Make sure you name the flags as labels or series name
3 Run below macro

Sub custom_markers()
Dim srs As Series
Dim cht As Chart
Dim mapfolder As String

' make sure you save the maps with series name

Get all Folder Names in a Folder

Names of all the folders in a folder Including Sub folder

If you want to get the names of all the folders stored/created in a directory/folder ( Including Sub folders).Try below code-

Sub folder_names_including_subfolder()
Application.ScreenUpdating = False
Dim fldpath
Dim fso As Object, j As Long, folder1 As Object
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
If fldpath = False Then
MsgBox "Folder Not Selected"

Get File Names in a Folder

Names of all the files in a folder Excluding Sub folder
If you want to get the names of all the files stored in a folder and excluding the files stored in a sub folder.Try below code-

Option Explicit
Sub file_names_in_folder_without_including_files_in_subfolder()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fldpath
Dim fld As Object, fil As Object, fso As Object, j As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next

Gantt Chart in Excel

Download and try these Templates

1 Gantt Chart Using Stacked Bar Chart

Download the working file here https://www.box.com/s/pwj2rq73zg0f8bg8tcke

Steps to use :

Download the template

Read the instructions on "Config Tab" to update it as per your requirement

2 Gantt Chart Using Formula's and Conditional Formatting

Shapes With VBA - Add a new text-box

Use : To add a new text-box using vba

Sub add_textbox_VBA()

Dim shp As Shape
Set shp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50) ' add shape
With shp
.TextFrame.Characters.Text = "Example" ' add text to display
.Top = Range("e2").Top ' adjust top
.Left = Range("e2").Left 'adjust left
.TextFrame.AutoSize = True ' turn on autosize
.Fill.ForeColor.RGB = RGB(255, 255, 204) 'choose fill color
.Line.Weight = 1 ' adjust width
.Line.ForeColor.RGB = RGB(255, 0, 18) ' choose color

Shapes With VBA - Format all textboxes on active sheet using VBA

Use: To change the fill color , border color , etc of all textboxes (shapes) on active sheet

Sub format_all_textboxes_using_vba()
Dim shp As Shape

For Each shp In ActiveSheet.Shapes
If shp.Type = msoTextBox Then ' choose shape
shp.Fill.ForeColor.RGB = RGB(255, 255, 204) ' choose fill color
shp.Line.Weight = 1 ' adjust width
shp.Line.ForeColor.RGB = RGB(255, 0, 18) ' choose color
shp.Line.DashStyle = msoLineSolid ' choose style
End If
Next

End Sub

Shapes With VBA - Format all lines on active sheet using VBA

Use: To change the color,style,etc of all lines (shapes) on active sheet

Sub format_all_lines_using_vba()
Dim shp As Shape

For Each shp In ActiveSheet.Shapes
If shp.Type = msoLine Then ' choose shape
shp.Line.Weight = 2 ' adjust width
shp.Line.ForeColor.RGB = RGB(255, 0, 18) ' choose color
shp.Line.DashStyle = msoLineDashDot ' choose dash style to apply
End If
Next

End Sub

Shapes With VBA - Display the cell value in a text

Use below lines to display the cell value in a text-box and then re-size the text-box as per the length of text

Sub cellvalue_in_textbox()
' display cell value in textbox
Sheets(1).Shapes("TextBox 1").TextFrame.Characters.Text = Range("b3").Value
' autosize the textbox as per the length of text
Sheets(1).Shapes("TextBox 1").TextFrame.AutoSize = msoAutoSizeTextToFitShape
End Sub

India Heat Map on Excel

 

Give a Christmas Look to your Charts

Wish you all Merry Christmas!

If you want to give Christmas look or use custom shapes instead of in-built markers on charts. Snapshot below-

Download Working File/Macro - https://www.box.com/s/02sfon6jloo7lpaj3s6c

Steps to use -

Download the working File
=> Goto “Data” sheet . Change chart data as per your requirement , series name,etc.
=> Add custom shapes to excel sheet which you would like to show instead of markers

2013 Calender in Excel

Download and try Calender in Excel. Snapshot below-

Download Link https://www.box.com/s/fe5hfdixf5eldknxnz7l

Steps to use -

1 Download the file
2 Add the reminders in "Reminders" sheet
3 Select the month from the drop-down on "Calender" sheet
4 Choose Year using scroll bar

UDF to find Redirect Web Url

Suppose you have the list of web URL's which are redirecting to new URL. To find the redirect/ new URL try this UDF-

Function redirect_url(surl As String) As String

Dim myIE As Object
Set myIE = CreateObject("InternetExplorer.Application")
myIE.Navigate surl
Do While myIE.Busy
Loop
redirect_url = myIE.Document.URL
myIE.Quit
Set myIE = Nothing

End Function

Navigate through all the worksheet and Press Ctrl + Home Using VBA

If you want to select the first cell after freeze pane on each worksheet and save it. So that when user opens the workbook he/she do not have to press CTRL+ Home in each worksheet to go to first cell.

Here is the code -

Sub goto_first_cell_in_each_worksheet()
Dim wk As Worksheet
For Each wk In ThisWorkbook.Worksheets
If wk.Visible = xlSheetVisible Then
wk.Select
If ActiveWindow.SplitRow = 0 And ActiveWindow.SplitColumn = 0 Then
Application.Goto Range("a1")
Else

Find The First Cell After Freeze Pane

If you want to know the first cell after the freeze pane . Try this code-

Sub find_first_cell_after_freeze_pane()
If ActiveWindow.SplitRow = 0 And ActiveWindow.SplitColumn = 0 Then
MsgBox "No freeze Pane Found"
Exit Sub
Else
MsgBox Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1).Address
End If
End Sub

Add Worksheet Navigation button on mouse right click

If you want to add a new button on mouse right click menu "Worksheet Navigation" showing the list of worksheets in active workbook and navigate easily.

Private Sub Workbook_Open()
On Error Resume Next
'Delete the new button if already exists
' name of the new button is "New Button"
Application.CommandBars("Cell").Controls("Worksheet Navigation").Delete
'run a macro to add a new button on mouse right click
Call add_new_button
End Sub

Syndicate content