I am working on a chart that I want to change data series every few seconds. After ten seconds, I want the data series to move from SERIES(Input!$A$4:$D$4,Input!$E$3:$F$3,Input!$E$4:$F$4,1) to SERIES(Input!$A$6:$D$6,Input!$E$3:$F$3,Input!$E$6:$F$6,1).
I have tried adapting the below code, but so far am only able to add a series, and not the data series row.
Sub ChangeChartRange()
Dim i As Integer, r As Integer, n As Integer, p1 As Integer, p2 As Integer, p3 As Integer
Dim rng As Range
Dim ax As Range
'Cycles through each series
Sheets("Dashboard").ChartObjects("Chart 1").Activate
'For n = 1 To ActiveChart.SeriesCollection.Count Step 1
r = 0
'Finds the current range of the series and the axis
For i = 1 To Len(ActiveChart.SeriesCollection(1).Formula) Step 1
If Mid(ActiveChart.SeriesCollection(1).Formula, i, 1) = "," Then
r = r + 1
If r = 1 Then p1 = i + 1
If r = 2 Then p2 = i
If r = 3 Then p3 = i
End If
Next i
MsgBox ActiveChart.SeriesCollection(1).Formula
'Defines new range
Set rng = Range(Mid(ActiveChart.SeriesCollection(1).Formula, p2 + 1, p3 - p2 - 1))
Set rng = Range(rng, rng.Offset(0, 1))
'Sets new range for each series
ActiveChart.SeriesCollection(1).Values = rng
'Updates axis
'Set ax = Range(Mid(ActiveChart.SeriesCollection(1).Formula, p1, p2 - p1))
'Set ax = Range(ax, ax.Offset(0,1))
'ActiveChart.SeriesCollection(1).XValues = ax
End Sub
Related
I have plotted a XY Scatter plot with VBA code. But I'm unable to change the horizontal axis labels. Can the horizontal axis labels be changed to text? If yes, how can I change it with arrays.
This is the XY Scatter chart I have created with VBA:XY Scatter chart
I would like to change the horizontal labels from 1,2,3,4 (as marked in the chart) to A,B,C,D using arrays. Thank you very much!
Edit:
My data table:
Data table
VBA macro code:
Sub plot_test3()
Dim ws2 As Worksheet
Dim i, j, c, m, n, a, lrow As Long
Dim frist_code, frist_value, frist_name, frist_date As Variant
Dim xychart As Chart
Set ws2 = Worksheets("Sheet3")
i = 1: j = 1: a = 1: k = 1: p = 2
c = 4: lrow = 6: m = 2: n = 2
ws2.Activate
ReDim frist_code(1 To lrow - 1)
ReDim frist_value(1 To lrow - 1)
ReDim frist_name(0)
ReDim frist_date(1 To lrow - 1)
Set xychart = ws2.Shapes.AddChart2(Left:=0, Top:=0, Width:=400, Height:=300).Chart
For j = 1 To c
For i = 1 To lrow - 1
frist_value(i) = ws2.Cells(m, n)
frist_code(i) = k
frist_name(0) = ws2.Cells(1, n)
frist_date(i) = ws2.Cells(m, 1).Value2
m = m + 1
Next i
xychart.SeriesCollection.NewSeries
xychart.ChartType = xlXYScatter
With xychart.SeriesCollection(a)
.Name = frist_name(0)
.Values = frist_value
.XValues = frist_code
.MarkerSize = 15
.MarkerStyle = 2
End With
a = a + 1
n = n + 1
m = 2
k = k + 1
Next j
xychart.Axes(xlCategory).TickLabelPosition = xlLow
xychart.SetElement (msoElementLegendBottom)
End Sub
XY Scatter is not adequate to such. XY expects continuous values over X axis and, as so, isn't compatible with named values.
To achieve desired labels, a discrete type chart must be used, like Line.
But for such, you can't have multiple values in same X value. You may:
consider using transposed data:
if color grouping required, using a serie by each point and then format every serie as required:
EDIT: Code for 2nd option:
Following code will produce desired chart. Note chart isn't interactive, ie, changing values in spreadsheet won't change chart!
Sub Plot_Chart()
Dim v(), r As Long, c As Long
'Create and use chart
With ActiveSheet.Shapes.AddChart(xlLineMarkers).Chart
'Clear all series and legend
While .SeriesCollection.Count
.SeriesCollection(1).Delete
Wend
.Legend.Delete
'Iterate through rows and columns of data
For r = 2 To Selection.Rows.Count
For c = 1 To Selection.Columns.Count
'Create series and use it
With .SeriesCollection.NewSeries 'chart.SeriesCollection
'Create data with single valid point
ReDim v(1 To Selection.Columns.Count)
v(c) = Selection(r, c)
.Values = v
End With
Next
Next
'Set and format X-Axis
.SeriesCollection(1).XValues = Selection.Rows(1).Value
With .Axes(xlCategory)
.MajorTickMark = xlNone
.TickLabelPosition = xlLow
End With
'Format series
For c = 1 To .SeriesCollection.Count
.SeriesCollection(c).MarkerStyle = xlMarkerStyleDiamond
.SeriesCollection(c).MarkerSize = 7
Set dbg = .SeriesCollection(c).Format.Fill
.SeriesCollection(c).Format.Fill.ForeColor.ObjectThemeColor = (c - 1) Mod Selection.Columns.Count + 5
.SeriesCollection(c).Format.Line.ForeColor.ObjectThemeColor = (c - 1) Mod Selection.Columns.Count + 5
Next
End With
End Sub
I'm currently working on a project which needs to build graph regarding to a table of analyses to check if the products work with time.
The user starts to choose which products he want to check and the code create a table regarding that.
The two main values are the date and the result which need to be on the graph and the third one is the batch number which needs to be the name of each chart series.
After that the code creates a 2D array with the table.
For Each elementReo In Range("tabReorganize[Date]")
ReDim Preserve tabReo(2, r)
tabReo(0, r) = elementReo
tabReo(1, r) = 0 & elementReo.Offset(0, 1)
tabReo(2, r) = elementReo.Offset(0, 2)
r = r + 1
Next elementReo
And after that I want to create the graph regarding to the number of different batch number that I have.
'This part create the Chart and set the title
Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=2979.75, Width:=550, Top:=358.5, Height:=325)
ChartObj.Chart.ChartType = xlLine
ChartObj.Chart.SetElement (msoElementChartTitleAboveChart)
ChartObj.Chart.ChartTitle.Text = "Humidite"
Dim tabNBN() As String
Dim NBN As Integer
Dim checkNBN As Boolean
ReDim tabNBN(NBN)
Dim SeriesI As Integer
NBN = 0
SeriesI = 0
'Add value in tabNBN regarding to the number of different batch number
For r2 = 0 To r - 1 Step 1
checkNBN = False
For Each elementNBN In tabNBN
If elementNBN = tabReo(1, r2) Then
checkNBN = True
End If
Next elementNBN
If checkNBN = False Then
ReDim Preserve tabNBN(NBN)
tabNBN(NBN) = tabReo(1, r2)
NBN = NBN + 1
End If
Next r2
So I need something to add the series regarding of the number of different batch number and insert the value and the date there.
I'm a beginner with charts in VBA.
if my understanding of the objective is correct then congratulation for a good & challenging question. Assuming the objective is to create a single chart with multiple series representing each batch listed in the range. If assumed result is like the following
then may try the test code (obviously after modifying the range, sheet etc to requirement). The code used Dictionary object, so please add Tools-> Reference to "Microsoft Scripting Runtime". Though I am not fully satisfied with the code regarding some multiple looping etc (degrading the performance) but would work OK with normal data assuming 100/200 rows. I invite experts response for more efficient code in this regard
Option Explicit
Sub test3()
Dim Cht As Chart, ChartObj As ChartObject
Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=10, Width:=550, Top:=10, Height:=325)
'Set ChartObj = ActiveSheet.ChartObjects("Chart 4")
Set Cht = ChartObj.Chart
Cht.ChartType = xlLine
Cht.HasTitle = True
Cht.ChartTitle.Text = "Humidite"
Dim Rw As Long, Dic As Dictionary, DataArr As Variant, OutArr() As Variant, BatchArr() As Variant, DateArr As Variant
Dim Rng As Range, SeriesNo As Long, Dmax As Date, Dmin As Date, dt As Date
Dim X As Long, i As Long, Xbatch As Variant, Batch As Variant
Dim Cnt As Long, Xval As Variant, PrvDt As Date, C As Range, DayCnt As Long
Dim firstAddress As String
Set Dic = CreateObject("Scripting.dictionary")
Set Rng = ThisWorkbook.ActiveSheet.Range("A2:A100") 'Modify to requireMent
DataArr = ThisWorkbook.ActiveSheet.Range("A2:C100") 'Modify to requireMent
SeriesNo = 0
'Create dictionary reference to unique Batch name from the list
For Rw = 1 To UBound(DataArr, 1)
Batch = DataArr(Rw, 2)
If Dic.Exists(Batch) = False Then
SeriesNo = SeriesNo + 1
Dic.Add Batch, SeriesNo
End If
Next
Dmax = Application.WorksheetFunction.Max(Range(Rng(1, 1), Rng(Rng.Rows.Count, 1)))
Dmin = Application.WorksheetFunction.Min(Range(Rng(1, 1), Rng(Rng.Rows.Count, 1)))
DayCnt = Dmax - Dmin + 1
ReDim BatchArr(1 To DayCnt)
ReDim DateArr(1 To DayCnt)
ReDim OutArr(1 To SeriesNo, 1 To DayCnt)
'Populate DateArr for dates
For X = 1 To DayCnt
DateArr(X) = Dmin + X - 1
Next
'Populate OutArr(Series,DayCnt) with existing Values, Non existing values are kept empty
For X = 1 To DayCnt
dt = DateArr(X)
With Rng
Set C = .Find(dt)
If Not C Is Nothing Then
firstAddress = C.Address
Do
OutArr(Dic(C.Offset(0, 1).Value), X) = C.Offset(0, 2).Value
'Debug.Print C.Value, C.Offset(0, 1).Value, C.Offset(0, 2).Value
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
Next
With Cht
'delete If any automatically added series
For i = Cht.SeriesCollection.Count To 1 Step -1
.SeriesCollection(i).Delete
Next
'Create Series and Set Values & Xvalues from OutArr
Dim Srs As Series
For X = 1 To SeriesNo
Batch = Dic.Keys(X - 1)
For Cnt = 1 To DayCnt
BatchArr(Cnt) = OutArr(Dic(Batch), Cnt)
'If IsEmpty(BatchArr(Cnt)) = False Then Debug.Print X, Cnt, BatchArr(Cnt), DateArr(Cnt)
Next
Cht.SeriesCollection.NewSeries
Set Srs = Cht.SeriesCollection(X)
With Srs
.Values = BatchArr
.XValues = DateArr
.Name = Dic.Keys(X - 1)
End With
Next
Dim Cat As Axis
Set Cat = Cht.Axes(xlCategory)
Cat.TickLabels.NumberFormat = "dd/mm/yy"
End With
End Sub
Please comment if it suits your need
This code should create a table regarding to another table (the one with all different batch numbers and values) and the user selection and after build the chart with it.
I can send you the full file by mail if needed.
Thanks in advance.
Best regards
colin
Private Sub BtnGraph2_Click()
Dim tabBNumber() As String
Dim tabHumidite() As Double
Dim tabDate() As String
Dim tabReo() As String
Dim y As Integer
Dim h As Integer
Dim d As Integer
Dim a As Integer
Dim w As Integer
Dim w2 As Integer
Dim r As Integer
h = 0
y = 0
d = 0
w = 1
w2 = 1
r = 0
ReDim tabHumidite(h)
ReDim tabBNumber(y)
ReDim tabDate(d)
Range("tabReorganize[#data]") = ""
ListObjects("tabReorganize").Resize Range(Range("tabReorganize[#headers]").Address, Range("tabReorganize[#headers]").Offset(1).Address)
For i6 = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i6) = True Then
ReDim Preserve tabBNumber(y)
tabBNumber(y) = ListBox1.List(i6)
y = y + 1
End If
Next i6
For Each delement In tabBNumber
For Each delement2 In Range("tabGraph[Date]")
If "0" & delement2.Offset(0, 2) = delement Or delement2.Offset(0, 2) = delement Then
ReDim Preserve tabDate(d)
tabDate(d) = delement2
d = d + 1
End If
Next delement2
Next delement
For Each Oelement In tabDate
Range("tabReorganize[Date]").Cells(w) = Format(Oelement, "mm/dd/yyyy")
w = w + 1
Next Oelement
If BtnHumidite = True Then
For Each element In tabBNumber
h = 0
a = 0
ReDim tabHumidite(h)
For Each Gelement In Range("tabGraph[Humidite]")
If "0" & Gelement.Offset(0, -1) = element Or Gelement.Offset(0, -1) = element Then
ReDim Preserve tabHumidite(h)
tabHumidite(h) = Gelement
h = h + 1
End If
Next Gelement
For Each O2element In tabHumidite
Range("tabReorganize[Humidite]").Cells(w2) = Format(O2element, "###0.00")
Range("tabReorganize[Batch Number]").Cells(w2) = Format(element, "00000000")
w2 = w2 + 1
Next O2element
Next element
End If
Range("tabReorganize").Sort Key1:=Range("tabReorganize[[#All],[Date]]"), Order1:=xlAscending, Header:=xlYes
For Each elementReo In Range("tabReorganize[Date]")
ReDim Preserve tabReo(2, r)
tabReo(0, r) = elementReo
tabReo(1, r) = 0 & elementReo.Offset(0, 1)
tabReo(2, r) = elementReo.Offset(0, 2)
r = r + 1
Next elementReo
'''' Chart part
Dim Cht As Chart, ChartObj As ChartObject
Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=2979.75, Width:=550, Top:=358.5, Height:=325)
Set Cht = ChartObj.Chart
Cht.ChartType = xlLine
Cht.HasTitle = True
Cht.ChartTitle.Text = "Humidite"
Dim Rw As Long, Dic As Dictionary, DataArr As Variant, OutArr() As Variant, BatchArr() As Variant, DateArr As Variant
Dim Rng As Range, SeriesNo As Long, Dmax As Date, Dmin As Date, dt As Date
Dim X As Long, i As Long, Xbatch As Variant, Batch As Variant
Dim Cnt As Long, Xval As Variant, PrvDt As Date, C As Range, DayCnt As Long
Dim firstAddress As String
Set Dic = CreateObject("Scripting.dictionary")
Set Rng = ThisWorkbook.ActiveSheet.Range("AP13:AP42") 'Modify to requireMent
'Set Rng = ThisWorkbook.ActiveSheet.Range("tabReorganize[Date]")
DataArr = ThisWorkbook.ActiveSheet.Range("AP13:AR42") 'Modify to requireMent
'DataArr = ThisWorkbook.ActiveSheet.Range("tabReorganize[#data]")
SeriesNo = 0
'Create dictionary reference to unique Batch name from the list
For Rw = 1 To UBound(DataArr, 1)
Batch = DataArr(Rw, 2)
If Dic.Exists(Batch) = False Then
SeriesNo = SeriesNo + 1
Dic.Add Batch, SeriesNo
End If
Next
Dmax = Application.WorksheetFunction.max(Range(Rng(1, 1), Rng(Rng.Rows.Count, 1)))
Dmin = Application.WorksheetFunction.Min(Range(Rng(1, 1), Rng(Rng.Rows.Count, 1)))
DayCnt = Dmax - Dmin + 1
ReDim BatchArr(1 To DayCnt)
ReDim DateArr(1 To DayCnt)
ReDim OutArr(1 To SeriesNo, 1 To DayCnt)
'Populate DateArr for dates
For X = 1 To DayCnt
DateArr(X) = Dmin + X - 1
Next
'Populate OutArr(Series,DayCnt) with existing Values, Non existing values are kept empty
For X = 1 To DayCnt
dt = DateArr(X)
With Rng
Set C = .Find(dt)
If Not C Is Nothing Then
firstAddress = C.Address
Do
OutArr(Dic(C.Offset(0, 1).Value), X) = C.Offset(0, 2).Value
'Debug.Print C.Value, C.Offset(0, 1).Value, C.Offset(0, 2).Value
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
Next
With Cht
'delete If any automatically added series
For i = Cht.SeriesCollection.Count To 1 Step -1
.SeriesCollection(i).Delete
Next
'Create Series and Set Values & Xvalues from OutArr
Dim Srs As Series
For X = 1 To SeriesNo
Batch = Dic.Keys(X - 1)
For Cnt = 1 To DayCnt
BatchArr(Cnt) = OutArr(Dic(Batch), Cnt)
'If IsEmpty(BatchArr(Cnt)) = False Then Debug.Print X, Cnt, BatchArr(Cnt), DateArr(Cnt)
Next
Cht.SeriesCollection.NewSeries
Set Srs = Cht.SeriesCollection(X)
With Srs
.Values = BatchArr
.XValues = DateArr
.Name = Dic.Keys(X - 1)
End With
Next
Dim Cat As Axis
Set Cat = Cht.Axes(xlCategory)
Cat.TickLabels.NumberFormat = "mm/dd/yy"
End With
I'm trying to create a macro for vba that grabs values entered in my A column of cells 1-1000, and then takes those values and plugs them into an function.
Rather than define a 1000 different values as:
x1 = Worksheets("Sheet1").Range("A1").Value
x2 = Worksheets("Sheet1").Range("A2").Value
x3 = Worksheets("Sheet1").Range("A3").Value
... etc
and then plugging them into my function
Dim dy As Integer, fx As Integer
dy = Range("B2").Value - Range("B1").Value
fx= dy*(x1+x2+x3....)
is there someway I can create a do loop that runs from cell A1 to A1000 grabbing each of their own values and plugging it into my function? Here's what I have so far but I'm not sure how I would have it grab the values entered in the cells.
xi = 1
Do
xi = 1 + xi
If xi = 1000 Then Exit Do
Count = Count + 1
Loop
'create a zero-based array o9f the values in A1:A1000
dim x as variant
with Worksheets("Sheet1")
x = application.transpose(.range("A1:A1000").value)
end with
'sum all of x
dim i as long, sumX as double
for i = lbound(x) to ubound(x)
sumX = sumX + x(i)
next i
'another way to sum A1:A1000
with Worksheets("Sheet1")
sumX = application.sum(.range("A1:A1000").value)
end with
'your function
Dim dy As long, fx As long
with Worksheets("Sheet1")
dy = .Range("B2").Value - .Range("B1").Value
end with
fx = dy * sumX
Below Query Works for you. The code flexible to get the row count in column "A". No need to hard code the upper bound value
Dim dy As Integer, fx As Integer, iCellSum As Integer
Sub Main()
iRowCount = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
iCellSum = 0
For i = 1 To iRowCount
iCellSum = iCellSum + Sheets("Sheet1").Cells(i, 1)
Next
dy = Range("B2").Value - Range("B1").Value
fx = dy * iCellSum
End Sub
I was wondering it is possible to transpose a specific number of columns in a single column and display it in a row. For example, if there was a column that extended from A1 to A1000000, is it is possible to select the first 272 data points and then transpose it into a single row starting at A1 and then select the next 272 rows and display it on B1 etc. until it reaches the last row.
Thanks,
Select A1:A272. Press Copy (or Ctl+C).
Select B1. Press Paste in the top left corner of the ribbon's Home tab.
Select Paste Special and Transpose in the dialog box that opens.
Sub CopyToRange()
Dim vDB, vR()
Dim rngDB As Range
Dim Cnt As Long, i As Long, j As Integer
Dim n As Long
Set rngDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
vDB = rngDB
Cnt = 272
For i = 1 To UBound(vDB, 1) Step Cnt
n = n + 1
ReDim Preserve vR(1 To Cnt, 1 To n)
For j = 1 To Cnt
If i + j - 1 > UBound(vDB, 1) Then GoTo p
vR(j, n) = vDB(i + j - 1, 1)
Next j
Next i
p:
Sheets.Add
Range("a1").Resize(n, Cnt) = WorksheetFunction.Transpose(vR)
End Sub
Sub Transp_mod2()
Dim P1 As Range, T2()
Set P1 = Sheets(3).UsedRange 'Adapt to your source column range
T1 = P1
Rws = P1.Count
Rmd = Rws
Spl = 272 'Adapt to your required steps
Cnt = 1
If Rws Mod Spl = 0 Then Rnds = Rws / Spl Else Rnds = Int(Rws / Spl) + 1
For i = 1 To Rnds
ReDim Preserve T2(1 To Spl, 1 To i)
If Rmd = Rws Mod Spl Then t = Rmd Else t = Spl
For j = 1 To t
T2(j, i) = T1(Cnt, 1)
Cnt = Cnt + 1
Rmd = Rmd - 1
Next j
Next i
Sheets(4).Range("A1").Resize(UBound(T2, 2), UBound(T2, 1)) = Application.Transpose(T2) 'Adapt "Sheets(4).range("A1")" to your destination range
End Sub
I am new to Excel VBA and I want to calculate the distance between two atoms and make a loop to calculate it for all wanted cases
with coordinate B(i), C(i), D(i) in the Excel sheet correspond to x,y,z cartesian coordinate..
these atoms are located : One in a row (i) and the other in a row (i+5)
I write this algorithm but I cant transfer it to excel VBA
For i=4 to 1000
For j=9 to 1000
d=SQRT(POWER(B(i)-B(j),2)+ POWER(C(i)-C(j),2)+ POWER(D(i)-D(j),2))
print **d** in (P(i)) #want to print the distance **d** in a case
j=j+4 # **j** is a multiple of 4
i=i+4 # **i** is a multiple of 4
next i
Thanks, this is my first question
I think that the following should work for you:
Sub FindDistances()
Dim i As Long, j As Long
Dim r As Long, c As Long 'row and column indices for output
Dim data As Variant
Application.ScreenUpdating = False 'useful when doing a lot of writing
data = Range("B4:D1000").Value 'data is a 1-based array
c = 5 'column E
For i = 1 To UBound(data) - 5 Step 4
r = 1 'first row printed in -- adjust if need be
For j = i + 5 To UBound(data) Step 4
Cells(r, c).Value = Sqr((data(i, 1) - data(j, 1)) ^ 2 + (data(i, 2) - data(j, 2)) ^ 2 + (data(i, 3) - data(j, 3)) ^ 2)
r = r + 1
Next j
c = c + 1
Next i
Application.ScreenUpdating = True
End Sub
Something like this? In VBA, you refer to cells like Cells(row, column). Data is supposed to be located in a worksheet named Sheet1. I'm calculating each dimension separately (d1, d2, d3) just for reading simplicity. You can merge those four lines in one if you like. EDIT: reading your comments above, I add a nested loop (j).
Sub Distances()
Dim i As Integer
Dim j As Integer
Dim d1 As Double, d2 As Double, d3 As Double, d As Double
For i = 4 To 1000 Step 4 'Can't understand your data, but Step 4 tries to account for your j=j+4 and i=i+4
For j = 9 To 1000 Step 4
d1 = (Worksheets("Sheet1").Cells(i, 2) - Worksheets("Sheet1").Cells(j, 2)) ^ 2
d2 = (Worksheets("Sheet1").Cells(i, 3) - Worksheets("Sheet1").Cells(j, 3)) ^ 2
d3 = (Worksheets("Sheet1").Cells(i, 4) - Worksheets("Sheet1").Cells(j, 4)) ^ 2
d = Sqr(d1 + d2 + d3)
Worksheets("Sheet1").Cells(i, 16).Value = d
Next j
Next i
End Sub
Option Explicit
Sub AtomDistance()
'
' AtomDistance Macro1
'
'
Dim i As Integer
Dim j As Integer
Dim Distance As Double
Dim Column As String
Column = InputBox("Which column you want to print results(put a letter)?")
Dim MyCell11 As String
Dim MyCell12 As String
Dim MyCell13 As String
Dim MyCell21 As String
Dim MyCell22 As String
Dim MyCell23 As String
Dim MyCell3 As String
j = 9
For i = 4 To 12
MyCell3 = Column & i
MyCell11 = "B" & i
MyCell12 = "C" & i
MyCell13 = "D" & i
MyCell21 = "B" & j
MyCell22 = "C" & j
MyCell23 = "D" & j
Distance = (((Range(MyCell11).Value - Range(MyCell21).Value) ^ 2) + ((Range(MyCell12).Value - Range(MyCell22).Value) ^ 2) + ((Range(MyCell13).Value - Range(MyCell23).Value) ^ 2)) ^ 0.5
If i Mod 4 = 0 Or j Mod 4 = 0 Then
Range(MyCell3).Value = Distance
End If
j = j + 1
Next i