I have following code in a subfunction:
If Auswertung.Controls("T" & Te & "F" & Fr & "Option1").Value = False Then
falseSelection = falseSelection + 1
end If
If Auswertung2.Controls("T" & Te & "F" & Fr & "Option1").Value = False Then
falseSelection = falseSelection + 1
end If
There are 15 UserForms, so I need to use a variable for the UserForm name.
"Auswertung" & X & .Controls("T" & Te & "F" & Fr & "Option1").Value
(This is wrong, but I do not know which capabilites VBA has)
Is there a way to accomplish this?
Access VBA
This is how you loop through all the forms of a project. In your case you can modify it to be stored in a variable and then run a check on .Name to see if it matches the form you need
Dim f
For Each f In CurrentProject.AllForms
Debug.Print f.Name
Next
OR you can simply refer to a form by its name in the following way
Forms.Item("Auswertung" & X).Controls
Excel VBA
Dim f As Object
For Each f In VBA.UserForms
Debug.Print f.Name
Next
Related
This is my first time writing anything in VBA- I'm trying to loop through a column (RRlist) and if the value is more than 20, add info about that cell from its row into another cell (rcomments). I want all of the info to add into that cell so it's a list.
When I try to run this code, nothing happens in my spreadsheet.
Option Explicit
Public rcomments As String
Public RRlist As Range
Public RRcell As Range
Sub WrittenMacro()
rcomments = ""
Set RRlist = Range("G33:G420")
For Each RRcell In RRlist
If RRcell.Value > 20 Then
rcomments = rcomments & "CUSIP " & RRcell.Offset(, -5).Value & ", " & RRcell.Offset(, -4).Value & "has a return of " & RRcell & "; "
End If
Next RRcell
End Sub
I am trying to create a function where if a number of checkboxes are ticked in a userform, then the formula in cell A1 shows a different formula with a Choose function.
The formula that I want to appear if all boxes are selected is:
=choose(randbetween(1,4),A3,A4,A5,A6)
If only certain boxes are selected e.g. boxes 1 and 3 are selected then the formula would be:
=choose(randbetween(1,4),A3,B1,A5,B1)
Where B1 is a reference to a blank cell.
The next formula would be dependent on the value of this cell.
Currently the approach I am taking is to do:
Dim a as range, b as range, c as range, d as range,
'set cell reference with data in if checkbox is selected, blank cell reference if checkbox not selected
If checkbox1.value=TRUE then
set a = range("A3")
else
set a = range("B1")
end if
'this is repeated for all checkboxes
Next I want to have it so the formula in A1 is
=choose(randbetween(1,4),a,b,c,d)
where a,b,c,d are the range that I have determined in the IF functions. This is where I am stuck. If I do
[A1]="=choose(randbetween(1,4),a,b,c,d)"
Then the formula doesn't pick up on the values
If I do:
Dim LValue As String
LValue = Choose(Application.RandBetween(1, 4), a, b, c, d)
[A1] = LValue
Then all that is returned is the value rather A1 having a formula within.
Any ideas?
Update:
Thank you for your suggestions. Inspiration struck after responding to your answers and the formula I needed was:
[A1] = "=choose(randbetween(1,4), " & a & "," & b & "," & c & "," & d & ")"
Which displays the formula in the cell with the variables changing. The variables had to be a string rather than a range too.
First, you need to delete the comma after d as range,.
Then you need to add double quotations around the text you paste into the formula.
[a1].Formula = "=choose(randbetween(1,4)," & Chr(34) & a & Chr(34) & "," & Chr(34) & b & Chr(34) & "," & Chr(34) & c & Chr(34) & "," & Chr(34) & d & Chr(34) & ")"
Thank you for your suggestions. Inspiration struck after responding to your answers and the formula I needed was:
[A1] = "=choose(randbetween(1,4), " & a & "," & b & "," & c & "," & d & ")"
Which displays the formula in the cell with the variables changing. The variables had to be a string rather than a range too.
I want to paste formula's in column B with a delay in between. The formula should only paste the formula if the cell left to it (in case of B1 this is A1) is not empty, like this:
I have the following VBA that pastes the formula with a delay of 1 sec.
Option Explicit
Sub RetrieveDataDelay()
'paste formulas into cells, then calculate, then delay rinse repeat
'=========================
'Declare Variables
'=========================
Dim i As Long 'used to loop
Dim rowCount As Long
Dim LastRow As Long 'used to find the last row
'=========================
'Setup for Speed
'=========================
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'=========================
'Define Variables
'=========================
LastRow = Worksheets(ActiveSheet.Name).Cells(Rows.Count, 1).End(xlUp).Row 'This will find the last used row in column A, change the number 1 to whatever column number you want
rowCount = 1 ' set to how many rows you want to do at a time
'=========================
'Do Work
'=========================
For i = 1 To LastRow Step rowCount
Range("B" & i, "B" & WorksheetFunction.Min(i + rowCount - 1, LastRow)).Formula = "'=IF(ISBLANK(A" & i & ");" & """" & """" & ";Dump(Volumes(A" & i & ";2528;1010;TRUE;" & "Volume" & ";TRUE)))" 'set the formula to whatever it needs to be
Calculate
Application.Wait (Now + TimeValue("00:00:01")) 'this delays 1 second
Next i
'=========================
'Setup for Speed - Reverse
'=========================
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
The error occurs at this part
Range("B" & i, "B" & WorksheetFunction.Min(i + rowCount - 1, LastRow)).Formula = "=IF(ISBLANK(A" & i & ");" & """" & """" & ";Dump(Volumes(A" & i & ";2528;1010;TRUE;" & "Volume" & ";TRUE)))"
The errors has something to due with the formula, which it does not accept. This is a custom formula used with an excel extension. I know that the formula works, as I put a single quotation mark in front as such:
Range("B" & i, "B" & WorksheetFunction.Min(i + rowCount - 1, LastRow)).Formula = "'=IF(ISBLANK(A" & i & ");" & """" & """" & ";Dump(Volumes(A" & i & ";2528;1010;TRUE;" & "Volume" & ";TRUE)))"
so that it pastes the formally literally. If I then remove the quotation mark from the formula the formula works. So the questions remains why it doesn't accept this specific formula in the VBA.
Using Excel 2013.
Range.Formula needs the formula notation always in en_us format independent of the current locale settings. That means functions in English language and also comma as delimiter between formula parameters and not semicolon.
So
.Formula = "=IF(ISBLANK(A" & i & ")," & """" & """" & ",Dump(Volumes(A" & i & ",2528,1010,TRUE," & "Volume" & ",TRUE)))"
After setting Range.Formula, the locale settings will be nevertheless active in the sheet. So in the sheet the formula will be delimited with semicolons if so set.
Btw.: The complicated string notation for double quotes is not neccessary.
.Formula = "=IF(ISBLANK(A" & i & "),"""",Dump(Volumes(A" & i & ",2528,1010,TRUE," & "Volume" & ",TRUE)))"
Looking for some guidance. I have created a statistics chart but also it lists the Top 5 WIP for certain categories.
the trouble I'm having is writing to text boxes on a chart. I have managed to do it with standard text boxes found on the insert tab but not with the ActiveX boxes which is what I need due to the need of scroll bars
Here is the function I have written to write strings to all text boxes.
Function Top5HeldCell(aSheet)
Dim row As Integer
Dim commentBox As TextBox
row = 12
For i = 4 To GetNumberOfEntries(aSheet, "A")
If Sheets(aSheet).Range("S" & i).Value <> "" Then
If Sheets(aSheet).Range("T" & i).Value = "" Then
rmNumber = Sheets(aSheet).Range("A" & i).Value
partNumber = Sheets(aSheet).Range("B" & i).Value
serialNumber = Sheets(aSheet).Range("C" & i).Value
ncNumber = Sheets(aSheet).Range("D" & i).Value
currentWIP = Sheets(aSheet).Range("W" & i).Value
Comments = Sheets(aSheet).Range("I" & i).Value
If row <= 16 Then
ActiveChart.Shapes.Range(Array("rmNumber" & row)).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = rmNumber
ActiveChart.Shapes.Range(Array("partNumber" & row)).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = partNumber
ActiveChart.Shapes.Range(Array("serialNumber" & row)).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = serialNumber
ActiveChart.Shapes.Range(Array("ncNumber" & row)).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ncNumber
ActiveChart.Shapes.Range(Array("WIPTime" & row)).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = currentWIP
' This works using standard textboxes
'ActiveChart.Shapes.Range(Array("comment" & row)).Select
'Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Comments
' here I'm trying to use ActiveX boxes
Charts("Statistics Chart").OLEObjects("comment" & row).Object.Text = ""
row = row + 1
End If
End If
End If
Next i
End Function
I seem to be getting the error 'Unable to get OLEObjects property of the Chart Class.
From using my nogging I expect this is something to do with the Charts not supporting this feature. Is there a work around that is known or am I really stuck???
Cheers
I have an excel with three columns and three rows like below:
Field1,Field2,Field3
Row1Value1,Row1Value2,Row1Value3
Row2Value1,Row2Value2,Row2Value3
Row3Value1,Row3Value2,Row3Value3
I want to write a VBA Macro to generate an output like below:
Field1=Row1Value1,Field2=Row1Value2,Field3=Row1Value3
Field1=Row2Value1,Field2=Row2Value2,Field3=Row2Value3
Field1=Row3Value1,Field2=Row3Value2,Field3=Row3Value3
Is there an easy way to do this?
Yes you could do it very simply in VBA (we can help you out after you've shared an attempt). If you just want the end result, it would be quicker for you to do with a basic (non-VBA) formula in the sheet.
= A$1 & "=" & B1 & "," & A$2 & "=" & B2 & "," & A$3 & "=" & B3
(Assuming your top left cell in the table is A1)
Think I got it working:
Sub Transform()
Dim i As Integer, j As Integer
For i = 2 To Worksheets("Input").UsedRange.Rows.Count
Dim row As String
row = ""
For j = 1 To Worksheets("Input").UsedRange.Columns.Count
row = row & Worksheets("Input").Cells(1, j) & "=" & Worksheets("Input").Cells(i, j) & ","
Next j
Worksheets("Result").Cells(i, 1) = Left(row, Len(row) - 1)
Next i
End Sub