I am fairly new to VBA and trying to select alternating points to place datalabels above and below.
Here is my code that is currently placing a datalabel below point 1 which I want, but then I want the 3rd point's label to be placed below as well, and the other ones above. I have tried many different loops and codes but nothing seems to work and I'm not sure why it seems to copy and paste instead of move the label.
For x = 1 To ActiveChart.SeriesCollection(1).Points.Count
With ActiveChart.SeriesCollection(1).Points(x).DataLabel
.Position = xlLabelPositionBelow
.Orientation = xlHorizontal
End With
x = x + 2
Next x
For x = 2 To ActiveChart.SeriesCollection(1).Points.Count
With ActiveChart.SeriesCollection(1).Points(x).DataLabel
.Position = xlLabelPositionAbove
.Orientation = xlHorizontal
End With
x = x + 2
Next x
This is what my code currently produces:
Here is what I would like it to do:
I feel like it is something simple that I am missing if this is possible. So any help would be greatly appreciated. Is it possible there is an easier way?
Thank you in advance.
The problem appears to be that you are 'over-iterating' x. Where you want x to go up by two, you're actually saying "x = x + 2" and THEN also saying "+ 1 x" (which is what Next does). You could solve this above by changing your For Loops to say "For x = 1 to 3 Step 2". Then when you loop with "Next x", it will add 2 instead of just 1.
However, I recommend you do it like the following, as it is (in my opinion) a little clearer that you want something for an even x, and something for an odd x:
For x = 1 To ActiveChart.SeriesCollection(1).Points.Count
With ActiveChart.SeriesCollection(1).Points(x).DataLabel
If x Mod 2 = 1 Then 'If x is odd, put label below point
.Position = xlLabelPositionBelow
.Orientation = xlHorizontal
Else 'if x is even, put label above point
.Position = xlLabelPositionAbove
.Orientation = xlHorizontal
End If
End With
Next x
ActiveChart.SeriesCollection(1).Points(1).DataLabel.Position = xlLabelPositionBelow
ActiveChart.SeriesCollection(1).Points(2).DataLabel.Position = xlLabelPositionAbove
ActiveChart.SeriesCollection(1).Points(3).DataLabel.Position = xlLabelPositionBelow
For x = 4 to ActiveChart.SeriesCollection(1).Points.Count
ActiveChart.SeriesCollection(1).Points(x).DataLabel.Position = xlLabelPositionAbove
Next
Related
I'm new to Julia and I am trying to implement Julia's multithreading but I believe I am running into the "race condition problem". Here I am plotting the mandelbrot but I believe because of the race condition the array index [n] is messing with the color mapping. I tried using the atomic feature to the index n but apparently i cant use that type as an index. Here are pictures to compare as well as the code block.
Thanks!
module MandelBrot
using Plots
#make some functions for mandelbrot stuff
#find out if a number is part of the set
#remember the mandelbrot is symmetrical about the real number plane
function mandel(c)
#determine if a number is in the set or not in the set -
max_iter = 1000;
bound = 2
z = 0
n = 0
#if the magnitude of z exceeds two we know we are done.
while abs(z)<bound && n<max_iter
z = z^2+c
n+=1
end
return n #if n is 1000 assume c is good, else not of the set
end
#map n to a color
function brot(n)
rgb = 250
m = (n%rgb) /rgb#divide 250
if 0< n <= 250
c = RGB(1,m,0)
elseif 250<n<=500
c = RGB(1-m,1,0)
elseif 500<n<=750
c = RGB(0,1,m)
elseif 750<n<=999
c = RGB(0,1-m,1)
else
c=RGB(0,0,0)
end
return c
#TODO: append this c to an array of color values
end
#mrandom
function mandelbrot(reals,imags)
#generate #real amount of points between -2 and 1
#and #imag amount of points between 0 and i
#determine if any of those combinations are in the mandelbrot set
r = LinRange(-2,1,reals)
i = LinRange(-1,1,imags)
master_list = zeros(Complex{Float64},reals*imags,1)
color_assign = Array{RGB{Float64}}(undef,reals*imags,1)
#n = Threads.Atomic{Int64}(1)
n = 1
Threads.#threads for real_num in r
for imaginary_num in i
#z = complex(real_num, imaginary_num) #create the number
#master_list[n] = z #add it to the list
#color_assign[n,1] = (brot ∘ mandel)(z) #function of function! \circ + tab
#or would this be faster? since we dont change z all the time?
master_list[n] = complex(real_num, imaginary_num)
color_assign[n,1] = (brot ∘ mandel)(complex(real_num, imaginary_num))
n+=1
#Threads.atomic_add!(n,1)
end
end
gr(markerstrokewidth=0,markerstrokealpha=0,markersize=.5,legend=false)
scatter(master_list,markerstrokecolor=color_assign,color=color_assign,aspect_ratio=:equal)
end
#end statement for the module
end
julia> #time m.mandelbrot(1000,1000)
2.260481 seconds (6.01 M allocations: 477.081 MiB, 9.56% gc time)
Here is what should help:
function mandelbrot(reals,imags)
r = LinRange(-2,1,reals)
i = LinRange(0,1,imags)
master_list = zeros(Complex{Float64},reals*imags,1)
color_assign = Array{RGB{Float64}}(undef,reals*imags,1)
Threads.#threads for a in 1:reals
real_num = r[a]
for (b, imaginary_num) in enumerate(i)
n = (a-1)*imags + b
master_list[n] = complex(real_num, imaginary_num)
color_assign[n, 1] = (brot ∘ mandel)(complex(real_num, imaginary_num))
end
end
gr(markerstrokewidth=0,markerstrokealpha=0,markersize=1,legend=false)
scatter(master_list,markerstrokecolor=color_assign,color=color_assign,aspect_ratio=:equal)
end
The approach is to compute n as a function of indices along r and i.
Also note that I use 1:reals and not just enumerate(r) as Threads.#threads does not accept arbitrary iterators.
Note though that your code could probably be cleaned up in other but it is hard to do this without a fully reproducible example.
I am trying to create an automated Goal Seek script for a interlinked cells and workbook. However, perhaps due to the complexity and number of interlinks, somehow under a certain condition the Goal Seek function converges at a very high or low x-value.
Is there a way to improve its accuracy by setting some kind of boundary (a < x < b) similar to that in Solver. The reason I don't want to add solver in VBA is that because some of the other users may not be activating their Solver add-ins.
This is what the Goal Seek value gives me for an initial guess of x =
0.5h = 500
This is what the X-value should be, with a random guess of x = 100
Another alternative that I could think about is to create some sort of manual iteration (e.g. Bisection method) Sub Routine, but again, the equations are pretty complex so this may not be ideal.
What I am doing at the moment is that to preset an initial value for the x if y (another parameter) is negative or positive. I reckon this has eliminated most of the invalid result, but it still gives an error on one or two occasion. Appreciate your input. Thanks.
Sub Guess()
' ------------- For Guessing Initial X-Value -----------
Dim i As Integer, j As Integer
For i = 4 To 11
For j = 18 To 25
If Worksheets("Crack Width").Range("I" & j) < 0 Then
'------------------------Pre-guess X_value to be 0.5X_bal if N<0-------------
Worksheets("Calcs").Range("B" & i) = Worksheets("Calcs").Range("C" & i).Value * 0.5
If Worksheets("Calcs").Range("B" & i) = 0 Then Worksheets("Calcs").Range("B" & i).ClearContent
i = i + 1
ElseIf Worksheets("Crack Width").Range("I" & j) >= 0 Then
'------------------------Pre-guess X_value to be 0.5h if N>0-------------
Worksheets("Calcs").Range("B" & i) = Worksheets("Calcs").Range("E" & i).Value * 0.5
If Worksheets("Calcs").Range("B" & i) = 0 Then Worksheets("Calcs").Range("B" & i).ClearContents
i = i + 1
End If
Next j
Next i
End Sub
I'm still new at VBA and I'm sure that this is a simple problem, but I'm comparing negative numbers who is lesser for example if I inputed textboxMIN to -7 and textboxMAX to -1 the result will be -1 will be less than -7. I don't know how to solve it because for me the condition is correct but the result isn't. Please take a look if there is a problem with my code
'/************PROCESS***************/
For t_int_iteratorI = 0 To txt_NumOperands.Value - 1
MultiPage1.Pages.Add
MultiPage1.Pages(t_int_iteratorI).Caption = "Variable" & t_int_iteratorI + 1
Call sub_LabelPerPage
Set p_var_SetTxtBox = frm_RangeForm.MultiPage1.Pages(t_int_iteratorI).Controls.Add("Forms.TextBox.1", "MinBox")
With p_var_SetTxtBox
.Top = 50
.Left = 100
End With
Set p_var_SetTxtBox = frm_RangeForm.MultiPage1.Pages(t_int_iteratorI).Controls.Add("Forms.TextBox.1", "MaxBox")
With p_var_SetTxtBox
.Top = 50
.Left = 300
End With
Next t_int_iteratorI
p_var_MaxValue = frm_RangeForm.MultiPage1.Pages(t_int_iteratorI).maxbox.Value
p_var_MinValue = frm_RangeForm.MultiPage1.Pages(t_int_iteratorI).MinBox.Value
If p_var_MinValue > p_var_MaxValue Then
MsgBox "MIN value should be lesser than MAX value."
Exit Sub
End If
Thank you in advance!
I need a pseudo random number generator for 2D Monte Carlo simulation that doesn't have the characteristic hyperplanes that you get with simple LCGs. I tested the random number generator Rnd() in Excel 2013 using the following code (takes about 5 secs to run):
Sub ZoomRNG()
Randomize
For i = 1 To 1000
Found = False
Do
x = Rnd() ' 2 random numbers between 0.0 and 1.0
y = Rnd()
If ((x > 0.5) And (x < 0.51)) Then
If ((y > 0.5) And (y < 0.51)) Then
' Write if both x & y in a narrow range
Cells(i, 1) = i
Cells(i, 2) = x
Cells(i, 3) = y
Found = True
End If
End If
Loop While (Not Found)
Next i
End Sub
Here is a simple plot of x vs y from running the above code
Not only is it not very random-looking, it has more obvious hyperplanes than the infamous RANDU algorithm does in 2D. Basically, am I using the function incorrectly or is the Rnd() function in VBA actually not the least bit usable?
For comparison, here's what I get for the Mersenne Twister MT19937 in C++.
To yield a better random generator and to make its performance faster, I modified your code like this:
Const N = 1000 'Put this on top of your code module
Sub ZoomRNG()
Dim RandXY(1 To N, 1 To 3) As Single, i As Single, x As Single, y As Single
For i = 1 To N
Randomize 'Put this in the loop to generate a better random numbers
Do
x = Rnd
y = Rnd
If x > 0.5 And x < 0.51 Then
If y > 0.5 And y < 0.51 Then
RandXY(i, 1) = i
RandXY(i, 2) = x
RandXY(i, 3) = y
Exit Do
End If
End If
Loop
Next
Cells(1, 9).Resize(N, 3) = RandXY
End Sub
I obtain this after plotting the result
The result looks better than your code's output. Modifying the above code a little bit to something like this
Const N = 1000
Sub ZoomRNG()
Dim RandXY(1 To N, 1 To 3) As Single, i As Single, x As Single, y As Single
For i = 1 To N
Randomize
Do
x = Rnd
If x > 0.5 And x < 0.51 Then
y = Rnd
If y > 0.5 And y < 0.51 Then
RandXY(i, 1) = i
RandXY(i, 2) = x
RandXY(i, 3) = y
Exit Do
End If
End If
Loop
Next
Cells(1, 9).Resize(N, 3) = RandXY
End Sub
yields a better result than the previous one
Sure the Mersenne Twister MT19937 in C++ is still better, but the last result is quite good for conducting Monte-Carlo simulations. FWIW, you might be interested in reading this paper: On the accuracy of statistical procedures in Microsoft Excel 2010.
That seems like it would take on average 1000 * 100 * 100 iterations to complete and VBA is usually a bit slower than native Excel formulas. Consider this example
Sub ZoomRNG()
t = Timer
[a1:a1000] = "=ROW()"
[b1:c1000] = "=RAND()/100+0.5"
[a1:c1000] = [A1:C1000].Value
Debug.Print CDbl(Timer - t) ' 0.0546875 seconds
End Sub
Update
It's not that bad at all! This will work too even without Randomize
Sub ZoomRNGs() ' VBA.Rnd returns Single
t = Timer
For i = 1 To 1000
Cells(i, 1) = i
Cells(i, 2) = Rnd / 100 + 0.5
Cells(i, 3) = Rnd / 100 + 0.5
Next i
Debug.Print Timer - t ' 0.25 seconds
End Sub
Sub ZoomRNGd() ' the Excel Function RAND() returns Double
t = Timer
For i = 1 To 1000
Cells(i, 1) = i
Cells(i, 2) = [RAND()] / 100 + 0.5
Cells(i, 3) = [RAND()] / 100 + 0.5
Next i
Debug.Print Timer - t ' 0.625 seconds
End Sub
and Single has about half of the precision of Double :
s = Rnd: d = [RAND()]
Debug.Print s; d; Len(Str(s)); Len(Str(d)) ' " 0.2895625 0.580839555868045 9 17 "
Update 2
I found C alternative that is as fast as VBA Rnd.
C:\Windows\System32\msvcrt.dll is the Microsoft C Runtime Library:
Declare Function rand Lib "msvcrt" () As Long ' this in a VBA module
and then you can use it like this x = rand / 32767 in your code:
Sub ZoomRNG()
t = Timer
Dim i%, x#, y#, Found As Boolean
For i = 1 To 1000
Found = False
Do
x = rand / 32767 ' RAND_MAX = 32,767
y = rand / 32767
If ((x > 0.5) And (x < 0.51)) Then
If ((y > 0.5) And (y < 0.51)) Then
' Write if both x & y in a narrow range
Cells(i, 1) = i
Cells(i, 2) = x
Cells(i, 3) = y
Found = True
End If
End If
Loop While (Not Found)
Next i
Debug.Print Timer - t ' 2.875 seconds
End Sub
After reading this question I got curious and found the paper
"Assessing Excel VBA Suitability for Monte Carlo Simulation" by Alexei Botchkarev that is available here. Both RAND and RND functions are not recommended, but as pointed out in the paper the Mersenne Twister has been implemented in VBA by Jerry Wang.
A quick search led me to this nicely commented Version that has been updated the last 2015/2/28: http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/VERSIONS/BASIC/MTwister.xlsb
Source: http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/VERSIONS/BASIC/basic.html
All LCGs will generate hyperplanes. The quality of the LCG increases with decreasing distance between these hyperplanes. So, having more hyperplanes than RANDU is a good thing.
The MT plot looks much better because it is NOT an LCG. Indeed, any non-LCG pRNG could have a random looking plot and still be a bad.
To avoid the problem of 2D correlations, you could use the same LCG for x and y but have different seeds for x and y. Of course, this will not work with RND because you cannot have two separate streams. You will need an LCG pRNG that takes the seed as an argument by reference.
As a balance between speed and goodness, I was thinking of combining them like
for...
z = [rand()] ' good but slow.
for .. ' just a few
t = z + rnd()
t = t - int(t)
...
Remember that good entropy + bad entropy = better entropy.
That said, only 0.05ms per [rand()].
I'm looking for a way to graph multiple point within an (X,Y) plane, and have them appear (then disappear) one at a time. I have a total of about 400 (x,y) points, which are position tracking information gathered from a Inertial Measurement Unit.
Each data point is separated by approx 4 ms (I can change this interval to make it longer), so if possible, I would like to display one dot at a time, each for 4ms, until the next dot appears. The final product should display the object's movement path over the 5-6 second sample time. From my excel file, I have two columns (one for X and one for Y) which are 400 elements long (400 rows).
I'm hoping for a way to plot the X,Y scatter information one row at a time, and looking for some code that will increment through each row and plot the corresponding scatter. I am a semi-fluent programmer, but have never used MS Visual Basic before. All the solutions for Excel that I have found so far (which are similar to my problem) involve writing code for the graph in Visual Basic. I think I may be able to get that working, if someone can help me with the code... but if there is another piece of software which does this (for free! I'm on a student budget!) then I am willing to try multiple solutions.
I found this code already:
Sub Macro1()
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A3:B3"), PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
With ActiveChart.Axes(xlCategory)
.MinimumScale = -30
.MaximumScale = 30
.MinorUnit = 1
.MajorUnit = 5
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = 2800
.MinorUnit = 50
.MajorUnit = 100
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
For I = 3 To Worksheets(1).Range("A65536").End(xlUp).Row
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A3:B" & I), PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
ST = Timer
While Timer < ST + 1
Wend
Next I
End Sub
However, being as there was no comments or documentation, I had difficulty perusing through it and picking it apart. I feel like once I can really understand the format of Visual basic I can modify the program to adapt for my specific needs... but understanding it is the first step.
So again, my information is in the format of 3 columns:
X displacement -- Y displacement -- Timestamp
(position in mm) (position in mm) (seconds, or iteration #, whichever is easier)