i'm trying to visualize my data that i have stored in a word table. I can call the table data with ThisDocument.Tables(6).Cell(i,j).Range.Text. I tried to copy this data to the datasheet of the word graph, but this was unsuccessful.
Word table with data
The chart has to visualize the amount of currency in a timeline with time on the x-axis and the amount of money on the y-axis. I have allready inserted a chart in my word document but i need to access its datasheet.
Graph in word that i want to show
Does anyone have an example code that i can use to solve this problem?
I'm trying to build my code like this:
Dim graph As Word.Chart
Set graph = ThisDocument.InlineShapes(1).Chart
If Not Len(ThisDocument.Tables(3).Cell(2, 1).Range.Text) = 2 Then
Dim temp As String
For i = 0 To ThisDocument.Tables(3).Rows.Count - 2
graph.ChartData.Workbook.Worksheets(1).Cells(1 + i, 1).Value = Left(ThisDocument.Tables(3).Cell(2 + i, 3).Range.Text, Len(ThisDocument.Tables(3).Cell(2 + i, 3).Range.Text) - 2)
temp = Left(ThisDocument.Tables(3).Cell(2 + i, 4).Range.Text, Len(ThisDocument.Tables(3).Cell(2 + i, 4).Range.Text) - 2)
graph.ChartData.Workbook.Worksheets(1).Cells(1 + i, 2).Value = Right(temp, Len(temp) - 2)
Next i
End If
I'm trying to build my code like this:
Dim graph As Word.Chart
Set graph = ThisDocument.InlineShapes(1).Chart
If Not Len(ThisDocument.Tables(3).Cell(2, 1).Range.Text) = 2 Then
Dim temp As String
For i = 0 To ThisDocument.Tables(3).Rows.Count - 2
graph.ChartData.Workbook.Worksheets(1).Cells(1 + i, 1).Value = Left(ThisDocument.Tables(3).Cell(2 + i, 3).Range.Text, Len(ThisDocument.Tables(3).Cell(2 + i, 3).Range.Text) - 2)
temp = Left(ThisDocument.Tables(3).Cell(2 + i, 4).Range.Text, Len(ThisDocument.Tables(3).Cell(2 + i, 4).Range.Text) - 2)
graph.ChartData.Workbook.Worksheets(1).Cells(1 + i, 2).Value = Right(temp, Len(temp) - 2)
Next i
End If
Related
I am trying to create an automatic filling of the payroll spreadsheet I created. However, no matter how much I try it the value of z = 1 all the time even if the logic returns FALSE values (I validated this using MsgBox).
My goal in this code is to check whether there is already a record in another sheet. If there isn't it will automatically add the record with the appropriate details based on the available data.
Below is the full VBA code (Note code is incomplete so it is a bit unpolished still):
Option Explicit
Public p As Long
Sub test()
Dim Total_rows_PR As Long
Dim Total_rows_DTR As Long
Total_rows_PR = Worksheets("Payroll - Regular").Range("B" & Rows.Count).End(xlUp).Row
Total_rows_DTR = Worksheets("DTR").Range("B" & Rows.Count).End(xlUp).Row
Dim q As Long
Dim j As Long
Dim z As Long
For j = 1 To Total_rows_DTR - 1
For q = 1 To Total_rows_PR + p - 2
If Worksheets("DTR").Cells(1 + j, 33) = Worksheets("Payroll - Regular").Cells(2 + q, 1) Then
If Worksheets("DTR").Cells(1 + j, 34) = Worksheets("Payroll - Regular").Cells(2 + q, 2) Then
If Worksheets("DTR").Cells(1 + j, 2) = Worksheets("Payroll - Regular").Cells(2 + q, 3) Then
z = 1
Exit For
End If
End If
End If
Next q
' Below is where the assignment should happen but only returns a blank cell
If z = 0 Then Worksheets("Payroll - Regular").Cells(Total_rows_PR + 1 + p, 1) = Worksheets("DTR").Cells(1 + j, 33)
If z = 0 Then Worksheets("Payroll - Regular").Cells(Total_rows_PR + 1 + p, 2) = Worksheets("DTR").Cells(1 + j, 34)
If z = 0 Then Worksheets("Payroll - Regular").Cells(Total_rows_PR + 1 + p, 3) = Worksheets("DTR").Cells(1 + j, 2)
If z = 0 Then p = p + 1
z = 0
Next j
End Sub
Update: I realized that even if the conditions are not being a met in the first portion of If-Then loops, the value of z is set to 1 for no reason. This is the reason why it won't assign values. However, I do not see why it keeps assigning to 1.
Update#2: #ShaiRado
So the first image is where data is encoded (not shown in image because it is in the leftmost part of the spreadsheet, but basically it inputs the name of the person, date, and the daily time record (DTR) of the person). When the data is encoded, it will automatically indicate what month and year it is based on the helper column AG month and column AH for year. Somewhere in the start of the same worksheet at column B is where the name of the person is. All of these 3 will be used.
This second image is where the summaries are computed. If there is an entry for a specific person at a certain month and year and it is not located in this worksheet, it will automatically fill in that person's name as well as the month and year. Basically that's what the code i'm trying to create does.
The output is a fully automated spreadsheet that only requires data entry in the DTR sheet. All computations already have their corresponding formulas.
First: You have a really strange way of writing your if-statements.
I think what you mean is
For q = 1 To Total_rows_PR + p
If Worksheets("DTR").Cells(1 + j, 33) = Worksheets("Payroll - Regular").Cells(2 + q, 1) _
And Worksheets("DTR").Cells(1 + j, 34) = Worksheets("Payroll - Regular").Cells(2 + q, 2) _
And Worksheets("DTR").Cells(1 + j, 2) = Worksheets("Payroll - Regular").Cells(2 + q, 3) Then
z = 1
Exit For ' Once found, z stays 1 so you don't have to continue the inner loop.
End If
Next q
Second: I am not sure what exactly you want to achieve, but as far as I understand, your problem is that you are looping to far. At the last iteration of the outer loop, your accessing row 1 + j of sheet DTR which is empty at that time, and you are accessing row 2 + q (which is the same as 2 + Total_rows_PR + p) - also empty (and comparing the two emtpy lines sets z to 1).
A variable is never set for no reason. Is is maybe set and you don't understand the reason.
Debug your code step by step, watch where it behaves different as you expect and find the reason why it does what is does.
j = LBound(arrayTime)
Do Until j = UBound(arrayTime)
j = j + 1
b = b + 1
cnc = b + r
MsgBox cnc
If cnc > 7 Then
b = 0
r = 0
cnc = b + r
End If
numMins = Sheet5.Cells(cnc + 3, 2) - arrayTime(j)
If numMins < 0 Then
g = g + 1
ReArrangeArray arrayTime, j
'ReDim Preserve arrayTime(numrows - 1 + g)
'arrayTime(numrows - 1 + g) = arrayTime(j)
'MsgBox (arrayTime(numrows - 1 + g))
Else
Sheet5.Cells(cnc + 3, 2) = numMins
End If
Loop
If the if statement is true I want to be able to put the array value at the end of the array and remove that value from its current spot. As the code is, it just adds it to the end and increases the size of the array from 12 to 13. How can I get the array to remain size 12 and still place the value at the end of the array and then remove it from its original position? I do not want to touch the array values in front. Just want to take that value and move it to the end.
For instance
array(1,2,3,4,5)
If statement
j on third loop.
array(j)=3
end array should be
array(1,2,4,5,3)
You could use a helper Sub like this one:
Sub ReArrangeArray(inputArray as Variant, indexToSwap as long)
Dim I As Long
Dim tempVal As Variant
If indexToSwap >= LBound(inputArray) And indexToSwap < UBound(inputArray) Then
tempVal = inputArray(indexToSwap)
For I = indexToSwap To UBound(inputArray) - 1
inputArray(i) = inputArray(i + 1)
Next I
InputArray(UBound(inputArray)) = tempVal
End If
End Sub
To be called by your main Sub as follows:
ReArrangeArray arrayTime, j
Using excel visual basic, I want to select multiple figures and group them, repeatedly.
My code goes like this:
circleCnt = 5
For j = 1 To circleCnt
ActiveSheet.Shapes.AddShape(msoShapeOval, 500, 30, 40, 30).Select
Selection.ShapeRange.Height = minWidth + circleWidth * (circleCnt - j + 1)
Selection.ShapeRange.Width = minWidth + circleWidth * (circleCnt - j + 1)
Selection.ShapeRange.IncrementLeft circleWidth / 2 * (j - 1) + circleWidth / 2
Selection.ShapeRange.IncrementTop circleWidth / 2 * (j - 1) + circleWidth / 2
Next j
Yep, it's drawing multiple circles and I'm trying to present my data with these codes. The problem is... my full data makes more than a hundred group of circles and it takes forever to transfer all the circles into the powerpoint
I want to make circles from a sample into a group - and how can I select multiple shape objects? I was thinking like
for n = 1 to 5
select shape #n
next n
but as you can see, this didn't work
Is there any 'cumulative' code for selection? or selecting last object and make them into a group of previously grouped objects?
-I don't want to make 'all circles' into one group - a group for a sample, with multiple samples :)
After you add the shapes, you need to iterate over all the shapes on the sheet and store the shape names in an array. Using that, you can create a ShapeRange object and Group the shapes. Here is a code sample:
Sub GroupAllShapes()
Dim arrShapeNames() As Variant 'must be Variant to work with Shapes.Range()
Dim shp As Shape
Dim sr As ShapeRange
Dim ws As Worksheet
Dim i As Integer
Set ws = ActiveSheet
ReDim arrShapeNames(ws.Shapes.Count - 1)
i = 0
For Each shp In ws.Shapes
arrShapeNames(i) = shp.Name
i = i + 1
Next
Set sr = ws.Shapes.Range(arrShapeNames)
sr.Group
Set sr = Nothing
Set ws = Nothing
End Sub
Note: I ported this from some of my C# code and have the arrShapeNames array with a zero-based index. You may need to make it 1-based for VBA.
Try to avoid selecting anything in your code. This makes your code really slow. It's not entirely clear for me what you're trying to do, but try something like this:
dim objShape as Shape
for j = 1 To circleCnt
set objShape = Shapes.AddShape(msoShapeOval, 500, 30, 40, 30)
With objShape
.ShapeRange.Height = minWidth + circleWidth * (circleCnt - j + 1)
.ShapeRange.Width = minWidth + circleWidth * (circleCnt - j + 1)
.ShapeRange.IncrementLeft circleWidth / 2 * (j - 1) + circleWidth / 2
.ShapeRange.IncrementTop circleWidth / 2 * (j - 1) + circleWidth / 2
End With
next
set objShape = Nothing
I was running tests on my software today and found that some of the values it was producing weren't correct.
I decided to step through the code and noticed that the variables I had assigned to textbox values on my userform when hovered over said empty, even though when hovering over the textbox assigned to it, the value inputted by the user showed.
For Example,
n = BiTimeSteps_TextBox.Value
when hovered over
n = empty
even though
BiTimeSteps_TextBox.Value = 2
when hovered over.
So say I have a formula shortly after that says
d = n*2 ,
n when hovered over says empty and d is made 0 when it shouldn't be.
Someone told me if I switch it around to
BiTimeSteps_TextBox.Value = n
it should be recognised but it is still not.
What could possibly be causing this?
See full code below: (it aims to price options using the binomial tree pricing method)
S = BiCurrentStockPrice_TextBox.Value
X = BiStrikePrice_TextBox.Value
r = BiRisk_Free_Rate_TextBox.Value
T = BiexpTime_TextBox.Value
Sigma = BiVolatility_TextBox.Value
n = BiTimeSteps_TextBox.Value
Dim i, j, k As Integer
Dim p, V, u, d, dt As Double
dt = T / n ' This finds the value of dt
u = Exp(Sigma * Sqr(dt)) 'formula for the up factor
d = 1 - u 'formula for the down factor
'V value of option
'array having the values
Dim bin() As Double 'is a binomial arrays, it stores the value of each node, there is a loop
'work out the risk free probability
p = (1 + r - d) / (u - d)
'probability of going up
ReDim bin(n + 1) As Double
'it redims the array, and n+1 is used because it starts from zero
'------------------------------------------------------------------------------------------------------------------------------
''European Call
If BiCall_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, (u ^ (n - i)) * (d ^ i) * S - X)
'It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
'european put
If BiPut_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, X - (S * (u * (n - i)) * (d * i)))
' European Put- It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
For k = 1 To n 'backward column loop
For j = 1 To (n - k + 1) 'loop down the column loop
bin(j) = (p * bin(j) + (1 - p) * bin(j + 1)) / (1 + r)
Cells(j + 19, n - k + 2) = bin(j)
'' print the values along the column, view of tree
Next j
Next k
Worksheets("Binomial").Cells(17, 2) = bin(1) ' print of the value V
BiOptionPrice_TextBox = bin(1)
In VBA, I can easily pull in an sheet\range into an array, manipulate, then pass back to the sheet\range. I'm having trouble doing this in VB.Net though.
Here's my code.
Rng = .Range("a4", .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
Dim SheetArray(,) As Object = DirectCast(Rng.Value(Excel.XlRangeValueDataType.xlRangeValueDefault), Object(,))
For X As Integer = 0 To SheetArray.GetUpperBound(0)
If IsNothing(SheetArray(X, 0)) Then Exit For
SheetArray(X, 6) = SheetArray(X, 3)
SheetArray(X, 7) = CDbl(SheetArray(X, 3).ToString) - CDbl(SheetArray(X, 1).ToString) - _
CDbl(SheetArray(X, 7).ToString)
For Y As Integer = 0 To 3
SheetArray(X, Y * 2 + 1) = Math.Round(CDbl(SheetArray(X, Y * 2 + 1).ToString), 3)
Next
If Math.Abs(CDbl(SheetArray(X, 7).ToString)) > 0.1 Then _
.Range(.Cells(X + 1, 1), .Cells(X + 1, 8)).Font.Color = -16776961
Next
I'm getting an error on the first If IsNothing(SheetArray(X, 0)) Then Exit For
line. It is telling me index is out of bounds of the array. Any idea why? The SheetArray object contains the data, but I just am not sure how to get to it.
In the For you have to loop from 0 to Count - 1:
For X As Integer = 0 To SheetArray.GetUpperBound(0) - 1
'...
Next
That will fix your problem.