I wrote some code to collect numbers from a column then put those numbers within a specific range into another column on a different worksheet. The problem is that the ActiveX Command button that I'm using is private to the first worksheet. Here's the code:
Private Sub CommandButton1_Click()
Dim X As Integer
Dim Y As Integer
X = Range(J2).Value
Y = Range(K2).Value
RuntimeLR = Cells(Rows.Count, 4).End(xlUp).Row
If CommandButton1 = True Then
For I = 2 To RuntimeLR
If I >= X And I <= Y Then
Worksheets("Calculate Runtime").Cells(p + 1, 1) = I
p = p + 1
End If
Next I
End If
End Sub
Is there a way to make the ActiveX Control Button public? Thank you.
Private and Public only dictate where the code can be called from. In this case since it is an activeX command button event sub it exists on a worksheet's code behind. Only that button or subs in the same worksheet code behind can call it. So that isn't the issue.
There are three issues with the code here:
You need to declare all variables, or remove option explicit. option explicit is very handy though so don't remove it.
Range accepts strings (generally speaking), it thinks your Range(J2) means you have a variable called J2 you want Range("J2") to point to Cell J 2.
Your If will always be false, Command Buttons don't have a boolean for you to compare to like that. A checkbox or the like would, however.
All together:
Private Sub CommandButton1_Click()
Dim X As Long 'I made these longs, integer is worthless in VBA don't use it ever
Dim Y As Long
Dim runtimelr As Long
Dim i As Long
Dim p As Long
X = Range("J2").Value
Y = Range("K2").Value
runtimelr = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To runtimelr
If i >= X And i <= Y Then
Worksheets("Calculate Runtime").Cells(p + 1, 1) = i
p = p + 1
End If
Next i
End Sub
As an aside, your loop is not calculating run-time. It takes far less than 1 second for it to perform an iteration.
What you're looking for:
Dim X As Long
Dim Y As Long
Dim runtimelr As Long
Dim i As Long
Dim p As Long
X = Range("J2").Value
Y = Range("K2").Value
runtimelr = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To runtimelr
If Me.Cells(i, 4).Value >= X And Me.Cells(i, 4).Value <= Y Then
Worksheets("Calculate Runtime").Cells(p + 1, 1) = Me.Cells(i, 4).Value
p = p + 1
End If
Next i
Related
As you can see above, I have a table in a Excel sheet where indication A can have product 1, product 2 and so forth (The prods names are all different depending on the indication, this is just for simplicity!).
In my userform a similar format is presented. I want to basically match the indication name on my excel sheet with the indication name in my userform. If they match, then Product 11 gets A's Prod 1 name, Product 12 gets A's Prod 2 name and so forth.
I've tried the following, but I'm just starting using VBA so I'm sure it probably doesn't even make sense.
Dim code_ind As String
Dim sel_ind As String
Dim chkbx As Control
Dim labx As Control
Dim i As Integer
Dim col_value As Integer
Dim row_value As Integer
For i = 1 To 8
For j = 1 To 4
For row_value = 4 To 11
col_value = 0
Set chkbx = Me.Controls("seg_l_selInd_" & i)
Set labx = Me.Controls("seg_cb_selInd_" & i & j)
sel_ind = tWb.Worksheets("LALALA").Columns(2).Find(what:=chkbx)
If code_ind = sel_ind Then
labx.Name = tWb.Worksheets("LALALA").Cells(row_value, 3 + col_value)
col_value = col_value + 1
End If
Next row_value
Next j
Next i
Is there any way I can do this? I know I could just write the names manually, but I need my tool to be as flexible as possible. Ideally, if more information is added into the excel table, the userform will automatically update.
Please check the next way. I tried thinking your project in this way:
The form in the next example must be named frmChkBox. The check boxes on the form will have names like "CheckBox11", "CheckBox12" and so on, first digit after "CheckBox" string being the row and the next one the column. If you appreciate that your real situation will exceed one digit number for the row number, they can be separated by "_", or something else. You can also create the check boxes on the flay.
a. Please paste in the form code module the next code lines:
Option Explicit
Private ChkBColl As New Collection
Private ChkB() As New ChkBoxChClss
Private Sub UserForm_Initialize()
Dim ws As Worksheet, rng As Range, iRow As Long, iCol As Long
Dim ctrl As MSForms.Control, ext As String, arrUsed, k As Long
ReDim ChkB(32)
ReDim arrUsed(Me.Controls.count)
Set ws = Sheets("INDICATION-PRODUCT")
Set rng = ws.Range("B2:E9")
For iRow = 1 To 8
For iCol = 1 To 4
For Each ctrl In Me.Controls
If TypeOf ctrl Is MSForms.CheckBox Then
If IsError(Application.Match(ctrl.Caption, arrUsed, 0)) Then
ext = Right(ctrl.Caption, Len(ctrl.Caption) - 8)
If left(ext, 1) = iRow And Right(ext, 1) = iCol Then
ctrl.Tag = rng.cells(iRow, iCol).Address
ctrl.Caption = rng.cells(iRow, iCol).Value
arrUsed(k) = ctrl.Caption: k = k + 1
ChkBColl.Add ctrl, ctrl.Name
Set ChkB(k).chkBEvent = ctrl
End If
End If
End If
Next
Next iCol
Next iRow
End Sub
Public Sub DoSomething(chk As MSForms.CheckBox)
Dim ws As Worksheet
Set ws = Sheets("INDICATION-PRODUCT"): ws.Activate
If chk.Value = True Then
ws.Range(chk.Tag).Select 'do whatever needed with the cell...
Else
ws.Range("A1").Select
End If
End Sub
Each check box Tag will receive the associated cell address.
In order to automatically allocate the same event to all of them, a simple class wrapper (named `ChkBoxChClss') will be created. It will identify the clicked check box and send the object to a form sub, where to be processed as needed. Please, paste the next code in the class:
Option Explicit
Public WithEvents chkBEvent As MSForms.CheckBox
Private Sub chkBEvent_Change()
frmChkBox.DoSomething chkBEvent
End Sub
You can use the Public Sub DoSomething to deal with the check box being clicked. Now, clicking a check box, if its value is True the correspondent cell will be selected. If False, the "A1" cell will be selected. You can do whatever you need.
I was finally able to solve it!
The table I have on my worksheet (Image 1) has the indication column that corresponds to the indication values on my userform. For each indication, there are several products.
I want my tool to be as flexible as possible, so I needed to match the indication name and for each checkbox in my userform I would obtain it's name from the table.
For example: Indication A, Prod 1 = Prod 1 (Checkbox.Name = Cell(x,y))
This is the code that I'm using:
Dim code_ind As String
Dim sel_ind As String
Dim chkbx As Control
Dim labx As Control
Dim i As Integer
Dim j As Integer
Dim col_value As Integer
Dim row_value As Integer
For i = 1 To 8
Set chkbx = Me.Controls("seg_l_selInd_" & i)
sel_ind = tWb.Worksheets("INDICATION-PRODUCT").Columns(2).Find(what:=chkbx)
If chkbx = sel_ind Then
col_value = 0
While tWb.Worksheets("INDICATION-PRODUCT").Cells(i + 3, 3 + col_value) <> ""
For j = 1 To 4
Set labx = Me.Controls("seg_cb_selInd_" & i & j)
labx.Caption = tWb.Worksheets("INDICATION-PRODUCT").Cells(i + 3, 3 + col_value)
col_value = col_value + 1
Next j
Wend
End If
Next i
Does it make sense to you?
Is there any way to make my code more flexible? For example, I'm assuming there are 8 indications (i = 1 to 8), but realistically there could be more in the future.
I have gotten this code below, it has worked in excel and I have had someone go through it to ensure it works but just not enough time for EIKON to calculate all the values (stocks) that are in A270:A371. This program is suppose to enter values from A270:A371 into Homepage J2 that will give different ratings on stocks that are in Investing A249:B260, then the code proceeds to copy Investing a249:B260 and start pasting values into Daily strategies E5 (G5,I5,K5,etc.). You can see the macro working and changing through the values that are in A270:A371 but it is not allowing EIKON to calculate for bringing in all prices for each stock. When you do this one stock at a time it will work but not update through the macro. I need a line of code to tell EIKON to update/calculate each time a new value gets pasted into Homepage J2. Let me know what else you may need, and I can answer your questions.
Sub insertVarious()
'Application.CalculateFullRebuild
Const hpgName As String = "Homepage"
Const hpgCell As String = "J2"
Const invName As String = "Investing"
Const invAddr As String = "A249:B260"
Const invAddr2 As String = "A270:A371"
Const dstName As String = "Daily Strategies"
Const dstFirst As String = "E5"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim hpg As Range: Set hpg = wb.Worksheets(hpgName).Range(hpgCell)
Dim inv As Range: Set inv = wb.Worksheets(invName).Range(invAddr)
Dim inv2 As Range: Set inv2 = wb.Worksheets(invName).Range(invAddr2)
Dim UB1 As Long: UB1 = inv.Rows.Count
Dim UB2 As Long: UB2 = inv.Columns.Count
Dim NoA As Long: NoA = inv2.Rows.Count
Dim Daily As Variant: ReDim Daily(1 To UB1, 1 To NoA * UB2)
Dim Curr As Variant, j As Long, k As Long, l As Long
For j = 1 To NoA
hpg.Value = inv2.Cells(j).Value
'hpg.Parent.Calculate
'inv.Parent.Calculate
Curr = inv.Value
GoSub writeDaily
Next j
wb.Worksheets(dstName).Range(dstFirst).Resize(UB1, NoA * UB2) = Daily
MsgBox "Data transferred.", vbInformation, "Success"
Exit Sub
writeDaily:
For k = 1 To UB1
For l = 1 To UB2
Daily(k, (j - 1) * 2 + l) = Curr(k, l)
Next l
Next k
Return
End Sub
Dealing with async stuff in VBA is always a pain.
Have you tried Application.Calculate
Have you tried DoEvents
Have you tried Application.OnTime
If the time is not predictable you could also try:
oldValue = someRange.value
While someRange.value = oldValue
DoEvents
Wend
To wait until the data is present.
I have an Excel spreadsheet with several thousand lines of data which is broken up into multiple sections based on the Manager. I have created coding that hides any lines with a zero value within a range for the individual sections, but they run slow and I'm not sure if there is a faster way to accomplish the same result. Here is what I have so far:
Option Explicit
Public shp As Single
Public r1 As Single
Public r23 As Single
Public sFind as String
1st part of the coding, which designates the rows to be looped through within the manager group. I have a button for each Manager and a Sub Button#_Click() to go with each section of data. Below is an example for Button#1, each look the same other than row numbers being different.
Sub Button1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
shp = 6
r1 = 14
r23 = 36
Call Button_Macro
Application.ScreenUpdating = True
Application.DisplayAlerts = True
The above code calls the following code to run:
Sub Button_Macro()
Dim r as Single
Dim x as Single
Dim i as Single
Dim MyArray as Variant
Dim ShpName as String
ShpName = "Rounded Rectangle " & Shp
ActiveSheet.Shapes.Range(ShpName).Select
sFind = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text
If sFine = "-" Then
ActiveSheet.Shapes.Range(Array(ShpName)).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "+"
Rows(r1 & ":" & r23).Hidden = True
Else
ActiveSheet.Shapes.Range(Array(ShpName)).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "-"
Rows(r1 & ":" & r23).Hidden = False
MyArray = Range(Cells(r1,4), Cells(r23,6)).Value
r = 1
x = r1
For i = r1 to r23
If MyArray(r,1) + MyArray(r,2) + MyArray(r,3) = 0 Then
Rows(x).EntireRow.Hidden = True
End If
x = x + 1
r = r + 1
Next i
End If
Cells(r1 - 1, 2).Select
End Sub
Next to each section of data there is a button that has a + when all rows in the Manager's section are hidden, then when you click the button it runs the code and changes the button text to - and only shows rows with values greater than zero. When I click the button, it takes roughly 10 seconds for the code to run. I know that doesn't sound like much, but people expect that when they click the button the rows with values should appear immediately, not 10 seconds later so I'm trying to find out if there is a faster way of coding this. Thanks.
Check if there are formulas relying on visible cells only then turn Calculation to manual in the beginning and back to automatic in the end. Otherwise it will re-calculate on every row hide.
Note that instead of using these Public variables
Public shp As Single
Public r1 As Single
Public r23 As Single
Public sFind as String
you should give them as parameters of your procedure. Also row numbers are of type Long not Single and sFind should be a local variable of Button_Macro and not Public:
Option Explicit
Public Sub Button_Macro(ByVal shp As Long, ByVal r1 As Long, ByVal r23 As Long)
Dim sFind as String
'your code here …
End Sub
And call it like
Public Sub Button1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Button_Macro shp:=6, r1:=14, r23:=36
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
In this part I would recommend to stop using multiple counters as they all depend on each other the following
r = 1
x = r1
For i = r1 to r23
If MyArray(r,1) + MyArray(r,2) + MyArray(r,3) = 0 Then
Rows(x).EntireRow.Hidden = True
End If
x = x + 1
r = r + 1
Next i
can be written as
Dim i As Long 'i must be long too
For i = r1 to r23
If MyArray(i-(r1-1),1) + MyArray(i-(r1-1),2) + MyArray(i-(r1-1),3) = 0 Then
Rows(i).EntireRow.Hidden = True
End If
Next i
Please replace your loop with this one. Yours is convoluted and runs many, many times.
For R = R1 To R23
Myarray = Range(Cells(R, 4), Cells(R, 6)).Value
If MyArray(1, 1) + MyArray(1, 2) + MyArray(1, 3) = 0 Then
ActiveSheet.Rows(R).EntireRow.Hidden = True
End If
Next R
Note that row and column numbers should be contained in variables of Long data type. That's sufficient because they will never contain fractions which Longs can't handle.
I have worked out another answer for you which is more comprehensive. It's contained in a single procedure which is called by all the buttons. Depending upon the position of the button it works out which rows to hide, even if you add or delete rows in the future. You can also add or delete buttons.
Sub ShowHide_Click()
' 020
Dim Ws As Worksheet
Dim Button As Shape
Dim ButtonName As String, NextName As String
Dim ButtonID As Integer
Dim ShowRows As Boolean ' True if "+" was clicked
Dim Rstart As Long, Rend As Long ' rows to hide
Dim RowRange As Range
Dim Arr As Variant
Dim R As Long
Set Ws = ActiveSheet ' better name the sheet
' get the name of the button that was pressed
ButtonName = Application.Caller
Set Button = Ws.Shapes(ButtonName)
' read and reset the button
With Button.TextFrame.Characters
ShowRows = .Text = "+"
.Text = IIf(ShowRows, "-", "+")
End With
' assume the first row to hide will be 1 row below the button
Rstart = Button.TopLeftCell.Row + 1
' extract the ID from the name
Do
NextName = Right(ButtonName, ButtonID)
ButtonID = ButtonID + 1
If ButtonID >= Len(ButtonName) Then Exit Sub
If Not IsNumeric(Right(ButtonName, ButtonID)) Then Exit Do
Loop
ButtonID = Val(NextName)
' name the next button in serial sequence
NextName = Trim(Left(ButtonName, Len(ButtonName) - Len(NextName))) _
& Str(ButtonID + 1)
With Ws
' this test will return False if Shape(NextName) doesn't exist
If .Shapes(NextName).Name = NextName Then
' this presumes that the last row to be hidden will be the one
' just above the next button's TopLeftCell.
Rend = .Shapes(NextName).TopLeftCell.Row - 1
Else
' the specified button wasn't found
' change column is column B isn't dominant in this regard
Rend = .Cells(Ws.Rows.Count, "B").End(xlUp).Row
End If
' set the range attached to the button
Set RowRange = .Range(.Rows(Rstart), .Rows(Rend))
' show or hide rows
RowRange.Rows.EntireRow.Hidden = Not ShowRows
If ShowRows Then
For R = Rstart To Rend
Arr = Ws.Range(Cells(R, 4), Cells(R, 6)).Value
Ws.Rows(R).EntireRow.Hidden = (Arr(1, 1) + Arr(1, 2) + Arr(1, 3) = 0)
Next R
' ' consider this alternative (Delete Dim Arr if you choose this)
' For R = Rstart To Rend
' Ws.Rows(R).EntireRow.Hidden = (Application.Count(Ws.Range(Cells(R, 4), Cells(R, 6))) = 0)
' Next R
End If
.Cells(Rstart, "B").Select
End With
End Sub
I have added a lot of comments to the code to show how the code works and how to adjust it to work with your worksheet. However, there are a few condition which your worksheet must meet.
The buttons must all be of the same type, like "Rounded Rectangle".
They must be numbered consecutively. The numbers must not start from 1 (though I can't see why they shouldn't) but they must be numbered consecutively top to bottom. You can't add a button in the middle, like 1, 2, 3, 7, 4, 5, 6. The numbering must be 1, 2, 3, 4, 5, 6, 7.
i need to set a variable name that changes within a loop. Please look below:
The result i need is:
Vari1 = 1
Vari2 = 2
Vari3 = 3
What i tried:
for i = 1 to 3
Vari(i) = i ' (Vari & i) also doesnt work
next i
Any thoughts?
Thanks
First return the dynamic i from your code somehow (simplified below) then resize your array:
Sub Test()
Dim Vari() As Long
Dim i As Long, x As Long
'Get value of i somehow
i = 3
ReDim Vari(1 To i)
For x = 1 To i
Vari(x) = x
Next x
End Sub
Or populate a Variant data type array directly through Evaluate:
Sub Test()
Dim Vari() As Variant
Dim i As Long
'Get value of i somehow
i = 3
Vari = Evaluate("TRANSPOSE(ROW(1:" & i & "))")
End Sub
I have a list of 18,806 rows (worksheet named "Reference") that need to be deleted from a 90,000+ row excel sheet (worksheet named "To Delete"). I'm trying to create an array containing the row numbers in "Reference", iterate through the array, and delete each row in the array from "To Delete". So far I have:
Sub deleteRows()
Dim rowArray As Variant
ReDim rowArray(18085) As Integer
rowArray = Sheets("Reference").Range("A1:A18086").Value
Dim Arr As Variant
Dim del As Integer
Dim i As Integer
i = 1
For Each Arr In rowArray
del = Arr
Sheets("To Delete").Cells(del, 1).EntireRow.Clear
Next
End Sub
Edit: Figured it out! It just clears contents and has some memory overflow errors but I'm working around that. Just wanted to post here for future reference :)
Based on my previous comment, I offer a suggestion to not shift your row numbers:
For Each a In rowArray
del = rowArray(a)
Worksheets.Rows(del).ClearContents
Next a
Dim rowNum as Integer
rowNum = Worksheets.Rows.RowCount
While rowNum > 0
If Worksheets.Cells(rowNum,1).Value = "" Then
Worksheets.Rows(rowNum).Delete
End If
rowNum = rowNum - 1
Loop
Here is the code after the workup. This should be almost to the point of being usable:
Sub deleteRows()
Dim rowArray(18086) As Integer
Dim i As Integer, j As Integer, del As Integer, rowNum As Integer
i = 1
j = 18086
While i <= j
rowArray(i) = Sheets("Reference").Range(i, 1).Value
i = i + 1
Loop
For Each a In rowArray
del = rowArray(a)
Sheets("Reference").Rows(del).ClearContents
Next a
rowNum = Sheets("Reference").Rows.RowCount
While rowNum > 0
If Sheets("Reference").Cells(rowNum, 1).Value = "" Then
Sheets("Reference").Rows(rowNum).Delete
End If
rowNum = rowNum - 1
Loop
End Sub
Make sure you are defining your variables before you call them, for safety. This is a universal rule in code.
Try this:
Worksheets.Rows(i).Delete
With i as your row number.
Nb: It will cause a shit into your rows number