Create connections on map using X Y Scatter
Download the working file here
https://app.box.com/s/6oks8mpammnza49tg3k6luhgx7rc5ybp
Code to create connections:
Option Compare Text
Option Explicit
' for any query contact koul.ashish@gmail.com
Sub create_chart()
Dim srs As Series
Dim ap As Points
Dim valtocheck As String
Dim i As Long
Sheets("Map").Unprotect
Charts("Map").Select
valtocheck = Sheets("Database").Range("state_selected").Value
If Application.WorksheetFunction.CountIf(Sheets("Source Data").Range("A:A"), valtocheck) = 0 Then
MsgBox "Please make sure selected state data is added on source data tab", vbInformation, "Note:"
Exit Sub
End If
' xxxxxxxxxxxxxxxxxxxxx delete existing series
For Each srs In ActiveChart.SeriesCollection
srs.Delete
Next srs
' XXXXXXXXXXXXXXX adding series to charts
With Sheets("Source Data")
For i = 4 To .Range("a65356").End(xlUp).Row
If .Range("a" & i).Value = valtocheck Then
Set srs = ActiveChart.SeriesCollection.NewSeries
srs.Name = "='Source Data'!$E$" & i
srs.XValues = "='Source Data'!$B$" & i & ",'Source Data'!$F$" & i
srs.Values = "='Source Data'!$C$" & i & ",'Source Data'!$G$" & i
' xxxxxxx formatting the series
srs.Border.Color = vbRed
With srs.Format.Line
.Weight = 1
.EndArrowheadStyle = msoArrowheadTriangle
.DashStyle = msoLineDashDot
.EndArrowheadWidth = msoArrowheadWide
End With
srs.Smooth = True
End If
Next i
End With
Sheets("Map").Protect
End Sub
Download the working file here
https://app.box.com/s/6oks8mpammnza49tg3k6luhgx7rc5ybp
Code to create connections:
Option Compare Text
Option Explicit
' for any query contact koul.ashish@gmail.com
Sub create_chart()
Dim srs As Series
Dim ap As Points
Dim valtocheck As String
Dim i As Long
Sheets("Map").Unprotect
Charts("Map").Select
valtocheck = Sheets("Database").Range("state_selected").Value
If Application.WorksheetFunction.CountIf(Sheets("Source Data").Range("A:A"), valtocheck) = 0 Then
MsgBox "Please make sure selected state data is added on source data tab", vbInformation, "Note:"
Exit Sub
End If
' xxxxxxxxxxxxxxxxxxxxx delete existing series
For Each srs In ActiveChart.SeriesCollection
srs.Delete
Next srs
' XXXXXXXXXXXXXXX adding series to charts
With Sheets("Source Data")
For i = 4 To .Range("a65356").End(xlUp).Row
If .Range("a" & i).Value = valtocheck Then
Set srs = ActiveChart.SeriesCollection.NewSeries
srs.Name = "='Source Data'!$E$" & i
srs.XValues = "='Source Data'!$B$" & i & ",'Source Data'!$F$" & i
srs.Values = "='Source Data'!$C$" & i & ",'Source Data'!$G$" & i
' xxxxxxx formatting the series
srs.Border.Color = vbRed
With srs.Format.Line
.Weight = 1
.EndArrowheadStyle = msoArrowheadTriangle
.DashStyle = msoLineDashDot
.EndArrowheadWidth = msoArrowheadWide
End With
srs.Smooth = True
End If
Next i
End With
Sheets("Map").Protect
End Sub
No comments:
Post a Comment