Clicking on Form button should generate random array with 10 numbers, and sort it by calling module 'SortMas'
Private Sub CommandButton1_Click()
Dim i As Integer, b(10) As Single
Dim CurRange As Range
ActiveDocument.Paragraphs.Add
ActiveDocument.Content.InsertAfter Text:="Random array:"
ActiveDocument.Paragraphs.Add
For i = 1 To 10
b(i) = Int(10 * Rnd + 10)
ActiveDocument.Content.InsertAfter Text:=Str(b(i)) + " "
Next i
ActiveDocument.Paragraphs.Add
Text:="Sorted array: "
Call SortMas(b(), 10, 2)
ActiveDocument.Paragraphs.Add
For i = 1 To 10
ActiveDocument.Content.InsertAfter Text:=Str(b(i)) + " "
Next i
End Sub
Error on 4th line:
ActiveDocument.Paragraphs.Add
Error msg is on fourth line of code:
The code is working for me in the MS word.
Are you using excel or word?.
In Excel it will throw error 424 as paragraph is not part of excel, But it works good in Word. open Word---> Atl + F11 ---> Insert a module---> put the code it is working
Private Sub CommandButton1_Click()
Dim i As Integer, b(10) As Single
Dim CurRange As Range
'For i2 = 1 To 100
ActiveDocument.Paragraphs.Add
ActiveDocument.Content.InsertAfter Text:="Random array:"
ActiveDocument.Paragraphs.Add
For i = 1 To 10
b(i) = Int(10 * Rnd + 10)
ActiveDocument.Content.InsertAfter Text:=Str(b(i)) + " "
Next i
ActiveDocument.Paragraphs.Add
ActiveDocument.Content.InsertAfter Text:="Sorted array: "
'Call SortMas(b(), 10, 2)
ActiveDocument.Paragraphs.Add
For i = 1 To 10
ActiveDocument.Content.InsertAfter Text:=Str(b(i)) + " "
Next i
'Next
End Sub
Related
I am trying to copy the selected combobox values into the adjacent cell, when I code for the same I am getting
Run time error 5.
Private Sub CommandButton1_Click()
Dim projworkbook As Workbook
Dim page1 As Worksheet
Dim lColumn As Long
Dim CopiedColName as String
Set projworkbook = ActiveWorkbook
Set page1 = projworkbook.Worksheets("Project_Creation")
lColumn = page1.Cells(13, Columns.Count).End(xlToLeft).Column 'Getting the last used column number
If lColumn > 26 Then
CopiedColName = Chr(Int((lColumn - 1) / 26) + 64) & Chr(Int((lColumn - 1) Mod 26) + 65) 'Converting the col number to col name
Else
CopiedColName = Chr(lColumn + 64)
End If
Me.Cells("CopiedColName" & 4).Text = Me.ComboBox1.Text '-> I am getting run time error at this line
End Sub
use:
Me.Range(CopiedColName & 4).Value = Me.ComboBox1.Text '-> I am getting run time error at this line
I am running a MonteCarlo Simulation in Excel with VBA but I only receive #Name? errors in the respective cells. When I click into one of these cells, press F2 and then Return the error disappears and the value is properly calculated. What is wrong here?
This is the code line calculating the respective value:
ActiveCell.Formula = "=Start_Rate * EXP(NORM.S.INV(RAND())* Standard_Deviation * (" & i & " ^1/2)) "
And that is the entire code (if necessary):
Sub MC_Simulation()
Dim i As Integer
Dim k As Integer
Dim StartCell As Range
Dim start_row As Integer
Dim start_column As Integer
iterations = Worksheets("Run_MC").Range("MC_Simulations").Value
Duration = Worksheets("Run_MC").Range("Duration").Value
Mean = Worksheets("Run_MC").Range("Mean").Value
Start_Rate = Worksheets("Run_MC").Range("Start_Rate").Value
Standard_Deviation = Worksheets("Run_MC").Range("Standard_Deviation").Value
start_row = 15
start_column = 1
For i = 1 To Duration
For k = 1 To iterations
Worksheets("Run_MC").Cells(start_row, start_column + i).Select
Selection.Value = i
Worksheets("Run_MC").Cells(start_row + k, start_column).Select
Selection.Value = k
Worksheets("Run_MC").Cells(start_row + k, start_column + i).Select
ActiveCell.Formula = "=Start_Rate * EXP(NORM.S.INV(RAND())* Standard_Deviation * (" & i & " ^1/2)) "
'Selection.Value
Next k
Next i
End Sub
You need to take the VBA variables out of the quotations:
ActiveCell.Formula = "=" & Start_Rate & "*EXP(NORM.S.INV(RAND())*" & Standard_Deviation & "*(" & i & "^1/2))"
I am trying to move shapes on the 2nd sheet based on the values of the 1st sheet. I keep getting an error with the line....Shapes.Range(Array(.... below is the code.
Sub graphics_mover()
' graphics_mover Macro
Dim SWL_row As Double, PWL_row As Double
Dim rng As Variant, i As Integer, colNum As Integer, Data As Worksheet, Pict As Worksheet
Set Data = ThisWorkbook.Worksheets(1)
'Set Pict = ThisWorkbook.Worksheets(2)
Set Pict = Workbooks("Well Pictographs2.xlsm").Worksheets(2)
i = 1
For i = 1 To 27
SWL_row = Data.Cells(2, i + 1).Value
SWL_row = Int(SWL_row / 50 + 1)
Pict.Shapes.Range(Array("Isosceles Triangle " & i)).Select
Selection.Top = SWL_row * 15 + 4
PWL_row = Data.Cells(3, i + 1).Value
PWL_row = Int(PWL_row / 50 + 1)
Pict.Shapes.Range(Array("Freeform " & i)).Select
Selection.Top = PWL_row * 15 + 1
i = i + 1
Next i
'--------------------------
End Sub
the line that is causing the error is:
Pict.Shapes.Range(Array("Freeform " & i)).Select
I appreciate any solutions.
I'm curious as to what the value of i is when you crash. The code is largely the same as a recorded macro but the syntax is correct if the named shape(s) exist.
First run this small snippet to output all of the shapes' names to the VBE's Immediate Window (Ctrl+G).
Sub List_Shapes()
Dim i As Long
With Workbooks("Well Pictographs2.xlsm").Worksheets(2)
For i = 1 To .Shapes.Count
Debug.Print .Shapes(i).Name
Next i
End With
End Sub
When you are in the VBE, tap Ctrl+G to open the Immediate Window and check the output. Make sure you have Isosceles Triangle 1 through Isosceles Triangle 27 (inclusive).
Next run through this modification of your macro.
Sub graphics_mover()
Dim SWL_row As Double, PWL_row As Double
Dim rng As Variant, i As Integer, colNum As Integer, Data As Worksheet, Pict As Worksheet
On Error Resume Next
Set Data = ThisWorkbook.Worksheets(1)
With Workbooks("Well Pictographs2.xlsm").Worksheets(2)
For i = 1 To 27
SWL_row = Data.Cells(2, i + 1).Value
SWL_row = Int(SWL_row / 50 + 1)
If Not .Shapes("Isosceles Triangle " & i) Is Nothing Then
.Shapes("Isosceles Triangle " & i).Top = SWL_row * 15 + 4
Debug.Print "moved " & .Shapes("Isosceles Triangle " & i).Name
End If
PWL_row = Data.Cells(3, i + 1).Value
PWL_row = Int(PWL_row / 50 + 1)
If Not .Shapes("Freeform " & i) Is Nothing Then
.Shapes("Freeform " & i).Top = PWL_row * 15 + 1
Debug.Print "moved " & .Shapes("Freeform " & i).Name
End If
Next i
End With
End Sub
I'm not a big fan of using On Error Resume Next but you are dealing with an object that is avoiding detection. The VBE's Immediate window will report the shapes that it could move.
I am new to VBA and am trying to learn some of the functionality. What I have created is a code in excel that connects to an API and pulls data into a table. I need it to loop for a specified period of time (9am to 4pm) and refresh every 30 seconds. My problem is I just don't know how to accomplish this. Here is my code Please help! Thanks!!
Also the table being populated is setup in the following Columns: "Symbol" "Name" "Ask" "Bid" "Price" "Days Range" "1yr Target Price" "Volume" "Avg Daily Vol"
My Code:
Private Sub BTN_Start_Click()
Dim W As Worksheet: Set W = ActiveSheet
Dim Last As Integer: Last = W.Range("A10000").End(xlUp).Row
If Last = 1 Then Exit Sub
Dim Symbol As String
Dim i As Integer
For i = 2 To Last
Symbol = Symbol & W.Range("A" & i).Value & "+"
Next i
Symbol = Left(Symbol, Len(Symbol) - 1)
Dim url As String: url = "http://finance.yahoo.com/d/quotes.cvs?s=" & Symbol & "&f=snb2b3k1m2t8va2"
Dim Http As New winhttprequest
Http.Open "GET", url, False
Http.send
Dim Resp As String: Resp = Http.ResponseText
Dim Lines As Variant: Lines = Split(Resp, vbNewLine)
Dim sLine As String
Dim Values As Variant
For i = 0 To UBound(Lines)
sLine = Lines(i)
If InStr(sLine, ",") > 0 Then
Values = Split(sLine, ",")
W.Cells(i + 2, 2).Value = Split(Split(sLine, Chr(34) & "," & Chr(34))(1), Chr(34))(0)
W.Cells(i + 2, 3).Value = Values(UBound(Values) - 6)
W.Cells(i + 2, 4).Value = Values(UBound(Values) - 5)
W.Cells(i + 2, 5).Value = Values(UBound(Values) - 4)
W.Cells(i + 2, 6).Value = Values(UBound(Values) - 3)
W.Cells(i + 2, 7).Value = Values(UBound(Values) - 2)
W.Cells(i + 2, 8).Value = Values(UBound(Values) - 1)
W.Cells(i + 2, 9).Value = Values(UBound(Values))
End If
Next i
W.Cells.Columns.AutoFit
End Sub
You could put the main part of your code in this loop. It won't exit until the time is up.
Do while timevalue(now()) > #9:00:00# and timevalue(now()) < #16:00:00#
'do stuff
Application.Wait(Now + #0:00:30#)
loop
At the beginning of your current code put Call Timer
Then include this in another sub:
Sub Timer()
Dim CountDown As Date
CountDown = Now + TimeValue("00:00:30")
Application.OnTime CountDown, "BTN_Start_Click"
End Sub
This will run your code every 30 seconds from when you start it.
This is another option if you just want to click it and leave it...
Sub Timer()
If TimeValue(CStr(Now)) >= TimeValue("9:00:00 AM") And TimeValue(CStr(Now)) <= TimeValue("4:00:00 PM") Then
Dim CountDown As Date
CountDown = Now + TimeValue("00:00:30")
Application.OnTime CountDown, "BTN_Start_Click"
Else
Dim CountTWO As Date
CountTWO = Now + TimeValue("00:00:05")
Application.OnTime CountTWO, "Timer"
End If
End Sub
Sub BTN_Start_Click()
Call Timer
'Your code here
End Sub
This will check to make sure the time is between 9 am and 4 pm... then every thirty seconds it will check again. If its between 9 am and 4 pm then it will run your code.
I've been working on a macro for a client. Need to insert columns based on cell values.
I use the same code for each value:
ws.range(getcolumn(currentColumn + 1) & ":" & getcolumn(currentcolumn + 3)).EntireColumn.Insert
That works fine until I hit column 50, and then I get a runtime Error of 1004 that says "Method Range of Object Worksheet Failed"
Why am I getting this error?
Here is the getColumn() function:
Function getColumn(columnNumber As Integer) As String
Dim alphaNumber As Integer
Dim iRemainder As Integer
alphaNumber = Int(columnNumber / 27)
iRemainder = columnNumber - (alphaNumber * 26)
If alphaNumber > 0 Then
getColumn = Chr(alphaNumber + 64)
End If
If iRemainder > 0 Then
getColumn = getColumn & Chr(iRemainder + 64)
End If
End Function
Looks like the problem is in your getColumn() function.
When currentcolumn = 50 the getColumn is returning "A[" because iRemainder is 27 so your looking for Chr(91) which is [
Taken from this post try this:
Function getColumn(columnNumber As Integer) As String
If columnNumber < 27 Then
getColumn = Chr(64 + columnNumber)
Else
getColumn = getColumn((columnNumber - 1) \ 26) & getColumn((columnNumber - 1) Mod 26 + 1)
End If
End Function
I did a basic test using this sub:
Sub insertCol()
Set ws = Sheets("Sheet1")
For currentcolumn = 1 To 60
ws.Range(getColumn(currentcolumn + 1) & ":" & getColumn(currentcolumn + 3)).EntireColumn.Insert
Next currentcolumn
End Sub