I want to dynamically set the caption for an array of labels (within a VBA form) based on values stored in a worksheet. Thus far I can set them one-by-one like this:
Label1.Caption = MySheet.Range("A1").Value
Label2.Caption = MySheet.Range("B1").Value
Label3.Caption = MySheet.Range("C1").Value ...
Having lots of labels that follow a recurrent pattern, I want to use something smarter, like:
'Method1
For i = 1 To X
Dim MyLabel as Object: Set MyLabel = "Label" & i
MyLabel.Caption = MySheet.Cells(i + 1, i).Value
Next i
'Method2
For i = 1 To X
Label(i).Caption = MySheet.Cells(i + 1, i).Value
Next I
'Both Methods failed. I really appreciate some feedback on this.
Use Controls object
For i = 1 To X
Controls("Label" & i).Caption = MySheet.Cells(i + 1, i).Value
Next
If you want to use this in VBA:
For i = 1 To X
UserForm1.Controls("Label" & i).Caption = MySheet.Cells(i + 1, i).Value
Next
Related
This may sound like an easy question, but I couldn't find a simple way to write the output of a collection ( just a column ) to a worksheet.
Collection gives the correct answers on debug.print and all I want to do that simply put that output on a worksheet, and then clear the output.
This is my main code for collection;
Worksheets(Ders_Sheet_Adi).Visible = True
Dim LastRowXL_1, LastRowXL_2, LastRowXL_3 As Long
Dim uniques As Collection
Dim Source_XL As Range
LastRowXL_1 = Worksheets(Ders_Sheet_Adi).Cells(Rows.Count, 40).End(xlUp).Row
LastRowXL_2 = Worksheets(Ders_Sheet_Adi).Cells(Rows.Count, 41).End(xlUp).Row
LastRowXL_2_Q = LastRowXL_2 + 1
LastRowXL_3 = Worksheets(Ders_Sheet_Adi).Cells(Rows.Count, 42).End(xlUp).Row
LastRowXL_3_Q = LastRowXL_3 + 1
LastRowXL_4_Q = LastRowXL_3_Q + LastRowXL_1 + 1
XL_Main = WorksheetFunction.Max(LastRowXL_1, LastRowXL_2, LastRowXL_3)
Set Source_XL = Worksheets(Ders_Sheet_Adi).Range("AN2:AP" & XL_Main & "")
Set uniques = GetUniqueValues(Source_XL.Value)
I found a way, just by simply putting a For array after the collection.
I Put these codes after the collection and voila, it works right now;
Dim it_XL
Worksheets(Ders_Sheet_Adi).Range("AN1:AP1100").Select
Selection.ClearContents
it_XLQ = 1
For Each it_XL In uniques
If it_XLQ = 1 Then it_XLQ_M = 100 Else it_XLQ_M = it_XLQ - 1
Worksheets(Ders_Sheet_Adi).Range("AP" & it_XLQ & "") = it_XL
If Worksheets(Ders_Sheet_Adi).Range("AP" & it_XLQ & "") = Worksheets(Ders_Sheet_Adi).Range("AP" & it_XLQ_M & "") Then
Worksheets(Ders_Sheet_Adi).Range("AP" & it_XLQ & "").Delete
GoTo Son2
Else: GoTo Son3
End If
Son3:
it_XLQ = it_XLQ + 1
Next
Worksheets(Ders_Sheet_Adi).Range("AP1:AP20").Copy
Worksheets(Ders_Sheet_Adi).Range("AQ1:AQ20").PasteSpecial Paste:=xlPasteValues
Son2:
LastRow_END = Worksheets(Ders_Sheet_Adi).Cells(Rows.Count, 43).End(xlUp).Row
I'm trying to fill a stacked excel-diagram with images based on a cell value. I can do it for the first column, but not for the second.
Here's an example. I want to fill the orange area with an images based on the values in column B
And here's the VBA-code how i fill the first column with an image:
Sub fill_with_image()
With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1)
Set vAddress = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
For i = 1 To vAddress.Cells.Count
imagefile = Cells(i + 1, 1).Value
.Points(i).Format.Fill.UserPicture (imagefile & ".png")
Next i
End With
End Sub
The second part of my question: I can't find any documentation how to fill treemap-diagrams with images. Any idea if its possible?
Just loop to select SeriesCollection(2)
Sub fill_with_image()
Dim j as integer
For j = 1 to 2
With Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(j)
Set vAddress = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
For i = 1 To vAddress.Cells.Count
imagefile = Cells(i + 1, 1).Value
.Points(i).Format.Fill.UserPicture (imagefile & ".png")
Next i
End With
Next j
End Sub
I am trying to create a userform whereby people can place as many requests as they want with the ability to remove requests they no longer want, as well as other functionalities. I am having an issue with removing the dynamically created objects after the functions add-remove-add has been used in that sequence.
The code I have below has a snippet of the objects added to the userform along with dimension changes to the userform and objects already embedded in the userform. Other defined portions are not included below.
Dim RemoveButtonArray() As New Class_RemoveRequest
For i = Last To Last
Set AddRemoveButton = GenPurchaseRequest.Controls.Add("Forms.Image.1", "btnRemove" & ObjID)
With AddRemoveButton
'properties
End With
Set AddRemoveLabel = GenPurchaseRequest.Controls.Add("Forms.Label.1", "lblRemove" & ObjID)
With AddRemoveLabel
'properties
End With
Set AddRequest = GenPurchaseRequest.Controls.Add("Forms.Frame.1", "Frame" & ObjID)
With AddRequest
'properties
.Caption = "Purchase Request - " & ObjID
End With
With AddRequestButton
.Top = 168 + (126 * i)
.Left = 18
End With
With SubmitButton
.Top = 168 + (126 * i)
.Left = 200
End With
With CancelButton
.Top = 168 + (126 * i)
.Left = 381
End With
With GenPurchaseRequest
.ScrollHeight = 200 + (126 * i)
.ScrollTop = 200 + (126 * i)
End With
ReDim Preserve RemoveButtonArray(0 To i)
Set RemoveButtonArray(i).RemoveButton = AddRemoveButton
Next i
ObjID = ObjID + 1
Last = Last + 1
This works well and the form is populated with everything correctly. When the user removes a request, the below code works fine as well:
Public WithEvents RemoveButton As MSForms.Image
Private Sub RemoveButton_click()
Dim ConfirmRemoval As Integer
Dim rbRefNo As String
Dim rbRefNoConvert As Integer
ConfirmRemoval = MsgBox("Are you sure you would like to remove this request?", vbYesNo)
If ConfirmRemoval = vbYes Then
rbRefNo = Mid(Me.RemoveButton.Name, 10)
rbRefNoConvert = CInt(rbRefNo)
With GenPurchaseRequest
If Last > 1 Then
.Controls.Remove ("Frame" & rbRefNo)
.Controls.Remove ("btnRemove" & rbRefNo)
.Controls.Remove ("lblRemove" & rbRefNo)
For i = rbRefNoConvert + 1 To Last - 1
.Controls("Frame" & i).Top = .Controls("Frame" & i).Top - 126
.Controls("btnRemove" & i).Top = .Controls("btnRemove" & i).Top - 126
.Controls("lblRemove" & i).Top = .Controls("lblRemove" & i).Top - 126
Next i
.AddRequestButton.Top = .AddRequestButton.Top - 126
.SubmitButton.Top = .SubmitButton.Top - 126
.CancelButton.Top = .CancelButton.Top - 126
.ScrollTop = .ScrollTop - 126
.ScrollHeight = .ScrollHeight - 126
Last = Last - 1
Else
MsgBox "There is only one active Purchase Request."
End If
End With
Else
'do nothing
End If
End Sub
The user can then go back add additional requests as well as remove more requests that they no longer want. The problem arises when they add more requests and then attempt to remove the last one added directly after the removal. For example: I added 4 requests and then removed the 2nd one. I then added another request, but wanted to remove the 4th request, however, the remove button no longer works.
I believe that the issue is that I need to redefine the array used to store the removal buttons once the remove button function is called, however I have no idea how to do that. My current attempt at doing that is:
For j = 0 To Last
If j = rbRefNoConvert Then
j = j + 1
Else
ReDim RemoveButtonArray(0 To j)
Set RemoveButtonArray(j).RemoveButton = AddRemoveButton
End If
Next j
But that object reference is incorrect and I do not know how to reference it correctly. I tried referencing the control itself, but that did not work.
I am very new to the use of class modules, arrays, and dynamic userforms, so sorry for the lengthy question!
Any help would be very much appreciated!
I attempted a couple of things:
(1) Setting the reference to the control I wanted to delete as nothing in the array.
(2) Adding the controls to a collection rather than a dynamic array.
None of the above worked, so instead I used this last method.
(3) I cleared the text values of the controls that needed to be removed. Then, using a for loop, I moved all the text values of the controls after the ones I wanted to delete to the above frames. Then, I removed the last control, redefined the array (when the user clicks the button again to add another set of controls), and redefined my counter. The code is represented below.
Public WithEvents RemoveButton As MSForms.Image
Private Sub RemoveButton_click()
'Defines appropriate variables
Dim ConfirmRemoval As Integer
Dim rbRefNo As String
Dim rbRefNoConvert As Integer
'Asks user for input to remove a control
ConfirmRemoval = MsgBox("Are you sure you would like to remove this request?", vbYesNo)
If ConfirmRemoval = vbYes Then
'Extracts the name identifier from the control to be removed and also converts it into a number
rbRefNo = Mid(Me.RemoveButton.Name, 10)
rbRefNoConvert = CInt(rbRefNo)
With GenPurchaseRequest
If ObjID > 1 Then
'Loops through the dynamic form controls and adjusts the user-inputs to account for the removed control
For i = rbRefNoConvert To ObjID - 1
If i < (ObjID - 1) Then
.Controls("txtVendor" & i).Text = .Controls("txtVendor" & i + 1).Text
.Controls("txtItem" & i).Text = .Controls("txtItem" & i + 1).Text
.Controls("txtQuantity" & i).Text = .Controls("txtQuantity" & i + 1).Text
.Controls("txtProject" & i).Value = .Controls("txtProject" & i + 1).Value
.Controls("txtCatalog" & i).Text = .Controls("txtCatalog" & i + 1).Text
.Controls("txtDate" & i).Value = .Controls("txtDate" & i + 1).Value
Else
.Controls("txtVendor" & i).Text = .Controls("txtVendor" & i).Text
.Controls("txtItem" & i).Text = .Controls("txtItem" & i).Text
.Controls("txtQuantity" & i).Text = .Controls("txtQuantity" & i).Text
.Controls("txtProject" & i).Value = .Controls("txtProject" & i).Value
.Controls("txtCatalog" & i).Text = .Controls("txtCatalog" & i).Text
.Controls("txtDate" & i).Value = .Controls("txtDate" & i).Value
End If
Next i
'Removes selected remove button and associated form controls
.Controls.Remove ("Frame" & ObjID - 1)
.Controls.Remove ("AddRequestOptions" & ObjID - 1)
'Re-formats userform to adjust for removed controls
.AddRequestButton.Top = .AddRequestButton.Top - 126
.CopyRequestButton.Top = .CopyRequestButton.Top - 126
.SubmitButton.Top = .SubmitButton.Top - 126
.CancelButton.Top = .CancelButton.Top - 126
.ScrollTop = .ScrollTop - 126
.ScrollHeight = .ScrollHeight - 126
'Adjusts the object identifier variable to account for removed control
ObjID = ObjID - 1
Else
MsgBox "There is only one active Purchase Request."
End If
End With
Else
'do nothing
End If
End Sub
I wrote a macro to produce a histogram, given a certain selection. The code for the macro looks like this
Sub HistogramHelper(M As Range)
Dim src_sheet As Worksheet
Dim new_sheet As Worksheet
Dim selected_range As Range
Dim r As Integer
Dim score_cell As Range
Dim num_scores As Integer
Dim count_range As Range
Dim new_chart As Chart
Set selected_range = M
Set src_sheet = ActiveSheet
Set new_sheet = Application.Sheets.Add(After:=src_sheet)
title = selected_range.Cells(1, 1).Value
new_sheet.Name = title
' Copy the scores to the new sheet.
new_sheet.Cells(1, 1) = "Data"
r = 2
For Each score_cell In selected_range.Cells
If Not IsNumeric(score_cell.Text) Then
'MsgBox score_cell.Text
Else
new_sheet.Cells(r, 1) = score_cell
End If
r = r + 1
Next score_cell
num_scores = selected_range.Count
'Creates the number of bins to 5
'IDEA LATER: Make this number equal to Form data
Dim num_bins As Integer
num_bins = 5
' Make the bin separators.
new_sheet.Cells(1, 2) = "Bins"
For r = 1 To num_bins
new_sheet.Cells(r + 1, 2) = Str(r)
Next r
' Make the counts.
new_sheet.Cells(1, 3) = "Counts"
Set count_range = new_sheet.Range("C2:C" & num_bins + 1)
'Creates frequency column for all counts
count_range.FormulaArray = "=FREQUENCY(A2:A" & num_scores + 1 & ",B2:B" & num_bins & ")"
'Make the range labels.
new_sheet.Cells(1, 4) = "Ranges"
For r = 1 To num_bins
new_sheet.Cells(r + 1, 4) = Str(r)
new_sheet.Cells(r + 1, 4).HorizontalAlignment = _
xlRight
Next r
' Make the chart.
Set new_chart = Charts.Add()
With new_chart
.ChartType = xlBarClustered
.SetSourceData Source:=new_sheet.Range("C2:C" & _
num_bins + 1), _
PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, _
Name:=new_sheet.Name
End With
With ActiveChart
.HasTitle = True
.HasLegend = False
.ChartTitle.Characters.Text = title
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, _
xlPrimary).AxisTitle.Characters.Text = "Scores"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text _
_
= "Out of " & num_scores & " responses"
' Display score ranges on the X axis.
.SeriesCollection(1).XValues = "='" & _
new_sheet.Name & "'!R2C4:R" & _
num_bins + 1 & "C4"
End With
ActiveChart.SeriesCollection(1).Select
With ActiveChart.ChartGroups(1)
.Overlap = 0
.GapWidth = 0
.HasSeriesLines = False
.VaryByCategories = False
End With
r = num_scores + 2
new_sheet.Cells(r, 1) = "Average"
new_sheet.Cells(r, 2) = "=AVERAGE(A1:A" & num_scores & _
")"
r = r + 1
new_sheet.Cells(r, 1) = "StdDev"
new_sheet.Cells(r, 2) = "=STDEV(A1:A" & num_scores & ")"
End Sub
I am currently using a WorkBook that looks like this:
Eventually, I want to produce a macro that automatically iterates over each column, calling the Histogram Helper function with each column, producing multiple histograms over multiple worksheets. For now, I'm just trying to test putting in TWO ranges into HistogramHelper, like so:
Sub GenerateHistograms()
HistogramHelper Range("D3:D30")
HistogramHelper Range("E3:E30")
End Sub
However, upon running the Macro, I get a dialog box with the error number 400, one of the sheets is produced successfully with the worksheet title Speaker, and another sheet is produced with a numerical title and no content.
What is going on?
Edit: The workbook in question: https://docs.google.com/file/d/0B6Gtk320qmNFbGhMaU5ST3JFQUE/edit?usp=sharing
Edit 2- Major WTF?:
I switched the beginning FOR block to this for debugging purposes:
For Each score_cell In selected_range.Cells
If Not IsNumeric(score_cell.Text) Then
MsgBox score_cell.Address 'Find which addresses don't have numbers
Else
new_sheet.Cells(r, 1) = score_cell
End If
r = r + 1
Next score_cell
Whenever you run this, no matter which range you put as the second Macro call (in this case E3:E30) the program prints out that each cell $E$3- $E$30 is a non-text character. Why oh why?
Don't you need this?
Sheets(title).Activate
TIP: for this kind of recursive implementations implying many creations/deletions and getting every day more and more complex, I wouldn't ever rely on "Active" elements (worksheet, range, etc.), but in specific ones (sheets("whatever")) avoiding problems and easing the debugging.
------------------------ UPDATE
No, apparently, you don't need it.
Then, update selected_range.Cells(1, 1).Value such that it takes different values for each new worksheet, because this is what is provoking the error: creating two worksheets with the same name.
------------------------ UPDATE 2 (after downloading the spreadsheet)
The problem was what I thought: two worksheets created with the same name (well... not exactly: one of the spreadhsheets was intended to be called after a null variable). And the reason for this problem, what I thought too: relying on "Active elements". But the problem was not while using the ActiveSheet, but while passing the arguments: the ranges are given without spreadsheet and were taken from the last created spreadsheet. Thus, solution:
HistogramHelper Sheets("Sheet1").Range("D3:D30")
HistogramHelper Sheets("Sheet1").Range("E3:E30")
Bottom line: don't rely on "Active"/not-properly-defined elements for complex situations.
I'm having a weird problem.
I have a form that looks like the one in the image
Those checkboxes are generated with a peace of code like this one (there is a loop that increments the i and the l ...everything is fine there because the other components are generated through the same piece of code and I have no problem getting their values):
Public Sub AddCboxs(form, masina, nrmasini, replicare, nrcboxs)
Dim i, k, l As Integer
i = 0
l = 1
Do While i < nrmasini
Do While l < nrcboxs + 1
Set cControl = form.Controls("iooly" & i).Add("Forms.CheckBox.1", "sc" & l & "oly" & i, True)
With cControl
.Width = 15
.Height = 16
.Top = 200 + k
.Left = 205
End With
k = k + 35
l = l + 1
Loop
l = 1
k = 0
i = i + 1
Loop
End Sub
Now... I want to do the following thing. If the SC checkbox is checked I want to do some stuff that you'll see in the following piece of code ... without checking the value of the checkbox the code works just fine and does what I want it to do... but the problem is that I need to do it just when the checkbox is checked.
Public Sub CalcOly()
Dim i, j, k As Integer
Dim Rand, ContorVal, ContorTotal As Long
Dim ws As Worksheet
Set ws = Worksheets("Config")
Dim cControl As Control
i = 0
j = 1
ContorVal = 0
Do While i < 5
Do While j < 3
Rand = 30
If raport.Controls("sc" & j & "oly" & i).Value = True Then
Do While ws.Cells(Rand, 1).Value <> "" And Rand < 65536
If ws.Cells(Rand, 1).Value = raport.Controls("combo" & j & "oly" & i).Value Then
Set cControl = raport.Controls("iooly" & i).Add("Forms.Label.1", "valoare" & j & "oly" & i, True)
With cControl
.Caption = Int(ws.Cells(Rand, 2).Value * raport.Controls("q" & j & "oly" & i).Value) & " RON"
.Width = 55
.Height = 14
.Top = 42 + k
.Left = 225
End With
ContorVal = ContorVal + Int(ws.Cells(Rand, 2).Value * raport.Controls("q" & j & "oly" & i).Value)
End If
Rand = Rand + 1
Loop
End If
j = j + 1
k = k + 35
Loop
Set cControl = raport.Controls("iooly" & i).Add("Forms.Label.1", "totalval" & "oly" & i, True)
With cControl
.Caption = ContorVal & " RON"
.Width = 55
.Height = 14
.Top = 350
.Left = 225
End With
k = 0
j = 1
i = i + 1
ContorVal = 0
Loop
End Sub
Now here's the weird thing... if I click on CALCUL VALOARE (which calls the CalcOly procedure) it executes the code but no matter if the SC checkbox is checked or no it shows no value. If I go on page Olympia 4 or Olympia 5 it does what it needs to do but again... ignoring if the SC checkboxes are checked or not.
I tried to get the value of the checkbox in a separate caption and I observed that it doesn't get it... I really don't know why!
Thanks a lot for your help!
Later: http://www.youtube.com/watch?v=mPb617JxgtI I've uploaded a video to see how strange the app acts. I don't get it... if I remove the If that checks if the checkbox is True or False it works fine
You should show us the piece of code that generates the first checkboxes, especially if your other checkboxes work properly.
That said, several things:
In VBA, you can't declare variables this way:
Dim i, j, k As Integer
Dim Rand, ContorVal, ContorTotal As Long
You have to do:
Dim i As Integer, j As Integer, k As Integer
Dim Rand As Long, ContorVal As Long, ContorTotal As Long
See here
Debug
What did you see when debuging your userform. Do the raport.Controls("sc" & j & "oly" & i) exist ?
By the same way, you should have a look at raport.Controls() collection to see what are the elements and their properties.
That would tell you if your Controls were really created the way you wanted.
This seems a bit obscure but from the help for the Add method of the Controls property:
If you add a control at run time, you must use the exclamation syntax
to reference properties of that control. For example, to return the
Text property of a control added at run time, use the following
syntax:
userform1!thebox.text
You could try changing:
If raport.Controls("sc" & j & "oly" & i).Value = True Then
to:
If raport!("sc" & j & "oly" & i).Value = True Then
edit: I'd originally used a separate variable to build up the string but that wouldn't work as the program would look for a control with the same name as the variable rather than the value of the variable
edit2: if that doesn't work you could try:
If raport!"sc" & j & "oly" & i.Value = True Then
but it would depend on the precedence of ! and . relative to &
Just use these for your button click
if checkboxname.value = true then
invoke your function
end if