I thought I could group radio buttons by setting the LinkedCell property differently for those I wanted grouped together, however, in my code all of the buttons end up going to the same LinkedCell. I need to group RadioButtons dynamically because the numbers of buttons in the groups vary. I am working on an exam program and need to group RadioButtons for each question together, what would be the easiest way to accomplish this?
-next day
I discovered that I was not incrementing the name of the RadioButtons so every button had the same name. I also made the buttons smaller so that they did not overlap and I got everything to work when I manually placed GroupBoxes, now I have to add them from VBA and cross my fingers.
For c = 1 To ExamData(i, 7)
ws.Range("C3").Offset(rOff + z, cOff).Value = ExamData(i, a) 'write answer
rbCapt = CaptSelect(c) 'Set choice letter as caption
Set t = ws.Cells(rOff + v, 2)
Set rb = ws.OptionButtons.Add(t.Left + 20, t.Top, t.Width, t.Height)
With rb
.caption = rbCapt
.Name = "Btn" & Trim(Str(b))
.LinkedCell = "A" + Trim(Str(myRow)) '<- When myRow changes all Buttons change
End With
Well I worked through at, Adding GroupBoxes worked. Here is the final code:
For i = 1 To UBound(ExamData)
'write question number
ws.Range("B3").Offset(rOff, cOff).Value = Trim(Str(i)) + "."
myRow = ws.Range("B3").Offset(rOff, cOff - 1).Row 'row number of question
'write question
ws.Range("C3").Offset(rOff, cOff).Value = ExamData(i, 1)
'write answers & Radio Buttons
For c = 1 To ExamData(i, 7)
ws.Range("C3").Offset(rOff + z, cOff).Value = ExamData(i, a) 'write answer
rbCapt = CaptSelect(c) 'Get choice letter for radio button
Set t = ws.Cells(rOff + v, 2)
Set rb = ws.OptionButtons.Add(t.Left + 11, t.Top + 12, t.Width - 22, t.Height - 20)
With rb
.caption = rbCapt
.Name = "Btn" & Trim(Str(i)) & "-" & Trim(Str(b))
.LinkedCell = "D" + Trim(Str(myRow))
End With
v = v + 1
a = a + 1
b = b + 1
z = z + 1
Next c
'add GroupBox
pp = (myRow + 1 + ExamData(i, 7) - 1)
gbRange = "B" + Trim(Str(myRow + 1)) + ":B" + Trim(Str(pp))
Set vvv = ws.Range(gbRange)
Set gb = ws.GroupBoxes.Add(vvv.Left, vvv.Top, vvv.Width, vvv.Height)
With gb
.caption = ""
.Name = "gb" + Trim(Str(i))
End With
rOff = rOff + (ExamData(i, 7) + 2)
v = 4
z = 1
a = 2
Next i
Related
need to create a list in excel for all possible combinations (unique): Let say there are 5 buttons (e.g A B C D E) and 3 are selected. For any single combination, any selected button can't be repeated in that combination.
I should get 60 unique combinations ( 5 1 ) * ( 4 1 ) * ( 3 1 ) = 60. I need to create this list in excel.
e.g have A B C D E buttons. 3 buttons combinations: A B C; C B A; D A C; C D A; A D C; etc.
By "unique" I assume that you want to exclude things like AAD or ABB.
Consider:
Option Explicit
Sub Kombos()
Dim arr(1 To 5) As String
Dim brr(1 To 5) As String
Dim i As Long, j As Long, k As Long
Dim N As Long, V As String
arr(1) = "A"
arr(2) = "B"
arr(3) = "C"
arr(4) = "D"
arr(5) = "E"
N = 1
For i = 1 To 3
For j = i + 1 To 4
For k = j + 1 To 5
Cells(1, N) = arr(i) & arr(j) & arr(k)
N = N + 1
Next k
Next j
Next i
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 1 To 10
V = Cells(1, i).Value
brr(1) = Left(V, 1)
brr(2) = Mid(V, 2, 1)
brr(3) = Right(V, 1)
Cells(2, i) = brr(1) & brr(3) & brr(2)
Cells(3, i) = brr(2) & brr(1) & brr(3)
Cells(4, i) = brr(2) & brr(3) & brr(1)
Cells(5, i) = brr(3) & brr(1) & brr(2)
Cells(6, i) = brr(3) & brr(2) & brr(1)
Next i
End Sub
Each column is a different combination of 5 elements taken 3 at a time. (10 columns)
The rows below the first row list the various permutations of the column header.
my first post here. You guys have helped me million times, but this time I haven't managed to find the answer in google or here.
I created 2 for loops, one inside the other in Excel, shortened version here:
For r = 3 To 25
For col = rota_current_col To 100
Debug.Print "Current position:" & r & "," & col // + some code later
Next col
//some code
Next r
And first loop is not working at all. I'm not touching any of those values (r,col) in code inside loops. This debug print shows values form 3,7 to 3,100 but it's not looping to forth 'r' value.
I hope that is clear enough, thanks in advance!.
EDIT 1: Full loop as requested:
For r = 3 To 25 ' NOT WORKING :(
For col = rota_current_col To 100
Debug.Print "Current position:" & r & "," & col & " current Rota position: " & rota_current_row & "," & rota_current_col & " current Comp position: " & comp_current_row & "," & comp_current_col
Select Case Cells(rota_current_row, rota_current_col)
Case "U", "UZ", "U1", "UZ1"
If Cells(rota_current_row, rota_current_col) <> Cells(comp_current_row, comp_current_col) Then
result.Cells(current, 1) = rota.Cells(rota_current_row, 1)
result.Cells(current, 2) = rota.Cells(rota_current_row, 2)
result.Cells(current, 3) = rota.Cells(rota_current_row, 3)
result.Cells(current, 4) = rota.Cells(rota_current_row, rota_current_col)
result.Cells(current, 5) = rota.Cells(rota_current_row, rota_current_col).Address
result.Cells(current, 6) = comp.Cells(comp_current_row, comp_current_col)
result.Cells(current, 7) = comp.Cells(comp_current_row, comp_current_col).Address
current = current + 1
End If
End Select
rota_current_col = rota_current_col + 1
comp_current_col = comp_current_col + 1
Next col
rota_current_row = rota_current_row + 1
comp_current_row = comp_current_row + 1
Next r
Would you like me to paste full code?
the r will not go to 4 until col = 100. The inner loop needs to finish and then the outer loop starts.
try this
Sub yo()
r = 3
For col = rota_current_col To 100
Debug.Print "Current position:" & r & "," & col
r = r + 1
If r = 26 Then Exit Sub
Next col
End Sub
I have an array that plots data to a messagebox, how can I also have that same data on a different sheet?
The data I am working with is a linear cable cut list. It looks at the total cable length and the individual lengths and checks to see how many reels of cable I need for all the separate individual lengths.
Ideally Reel 1 lengths would go in column A and the next reel would be column B, so on and so forth with a blank column in between the different cable types.
'Message Box Output
For k = LBound(DetStk, 2) To UBound(DetStk, 2)
sMsg = sMsg & DetStk(1, k) & vbTab & vbTab _
& DetStk(0, k) & vbCrLf
Next k
THIS IS WHAT I GOT WORKING WITH HELP FROM "Splintered-Origins-Dev"
'Sheet Output
n = 3
q = rC + p - 6
For k = LBound(DetStk, 2) To UBound(DetStk, 2)
If k - 1 >= LBound(DetStk, 2) Then
If DetStk(0, k - 1) <> DetStk(0, k) Then
'Data line reset
n = 3
p = p + 1
q = rC + p - 6
wsVG.Cells(1, q).Value2 = cblType
wsVG.Cells(2, q).Value2 = DetStk(0, k) & " Reels"
End If
Else
wsVG.Cells(1, q).Value2 = cblType
wsVG.Cells(2, q).Value2 = DetStk(0, k) & " Reels"
End If
wsVG.Cells(n, q).Value2 = DetStk(1, k)
n = n + 1
Next k
It's not pretty or elegant, but the following code will allow you to output the data going to your message box to a new sheet "Reel Data". Just replace "loopvar" with whatever variable you're using to iterate through each loop. Additionally the "- 1" in the q variable for columns may or may not be needed depending on how your loop variable is set up. I also recommend adding someplace at the beginning of the sub Worksheets("Reel Data").Cells.Clear to wipe out any old data left behind by previous runs and p = 0 to reset the column counter.
n = 3 'Row
q = *loopvar* + p - 1 'Column
For k = LBound(DetStk, 2) To UBound(DetStk, 2)
If k - 1 >= LBound(DetStk, 2) Then 'If reel count changes, move over a column
If DetStk(0, k - 1) <> DetStk(0, k) Then
n = 3 'Row reset
p = p + 1 'Increment Column
q = *loopvar* + p - 1
Worksheets("Reel Data").Cells(2, q).Value2 = DetStk(0, k)
End If
Else
Worksheets("Reel Data").Cells(2, q).Value2 = DetStk(0, k) 'First Reel
End If
Worksheets("Reel Data").Cells(n, q).Value2 = DetStk(1, k)
n = n + 1 ' Increment Row
Next k
p = p + 1 'This will add an extra column before the next iteration
DetStk Array's 2 rows an k colunms . so You should switch the matrix to make it easier to see.
From
'Message Box Output
For k = LBound(DetStk, 2) To UBound(DetStk, 2)
sMsg = sMsg & DetStk(1, k) & vbTab & vbTab _
& DetStk(0, k) & vbCrLf
Next k
to
'Sheet Output
Sheets.Add
Range("a1").Resize(UBound(DetStk, 2) + 1, UBound(DetStk, 1) + 1) = WorksheetFunction.Transpose(DetStk)
I have an excel table where there are part codes in a column and for every part code, there are 3-4 subsections (1100-1400) with information which I need to attach to the part code in a column view.
The number of created rows depends on if there is data entered into subsection 1400. 1100-1300 has always information and needs to be converted into a table.
I don't even know from where to start so currently I have no code to show
I added a picture of how the data is represented and what the result should look like:
You could do it like that
Option Explicit
Sub TransformA()
Dim rg As Range
Dim lastRow As Long, lineNo As Long, i As Long, j As Long
Dim shInput As Worksheet, shResult As Worksheet
Dim vDat As Variant, resDat As Variant
Dim subSection As String
' Make sure you run the code with the data in the Activesheet
Set shInput = ActiveSheet
' And you have data which starts in row 4 with the heading in row 3
' otherwise adjust accordingly
lastRow = shInput.Range("A4").End(xlDown).Row
Set rg = shInput.Range("A4:I" & lastRow)
vDat = rg
ReDim resDat(1 To UBound(vDat, 1) * 4, 1 To 4)
lineNo = 1
For j = 1 To UBound(vDat, 1)
For i = 0 To 2
Select Case i
Case 0: subSection = "1100"
Case 1: subSection = "1200"
Case 2: subSection = "1300"
End Select
resDat(lineNo + i, 1) = vDat(j, 1)
resDat(lineNo + i, 2) = subSection
resDat(lineNo + i, 3) = vDat(j, 2 + 2 * i)
resDat(lineNo + i, 4) = vDat(j, 3 + 2 * i)
Next
i = 3
subSection = "1400"
If Len(vDat(j, 2 + 2 * i)) = 0 And Len(vDat(j, 3 + 2 * i)) = 0 Then
lineNo = lineNo + 3
Else
resDat(lineNo + i, 1) = vDat(j, 1)
resDat(lineNo + i, 2) = subSection
resDat(lineNo + i, 3) = vDat(j, 2 + 2 * i)
resDat(lineNo + i, 4) = vDat(j, 3 + 2 * i)
lineNo = lineNo + 4
End If
Next
' Output the result to a new sheet
Set shResult = Sheets.Add
With shResult
.Cells(1, 1).Value = "Part Code"
.Cells(1, 2).Value = "Subsection"
.Cells(1, 3).Value = "Time"
.Cells(1, 4).Value = "Text"
End With
shResult.Range("A2").Resize(UBound(resDat, 1), 4) = resDat
End Sub
I have the following VBA which is working fine
Worksheets(d).Cells(x, 5).Value = Application.WorksheetFunction.Max(Range("Data!E3:E7"))
This method should be nested in a FOR function such as
For i = 3 To j
Worksheets(d).Cells(x, 5).Value = Application.WorksheetFunction.Max(Range("Data!E3:E5"))
x = x + 1
Next
How can I parse the E3 and E7to be parameter based according to i meaning
E3 = "E" + i
E5 = "E" + i + 2
full example of what I'm trying:
For i = 3 To j
Worksheets(d).Cells(x, 5).Value = Application.WorksheetFunction.Max(Range("Data!E" + i + ":E" + i+2 +"))
x = x + 1
Next
Try
Sheets("Data").Range("E" & i & ":E" & (i + 2))
& is better than + in combining data of various types into a string. Also -- Range is a child of WorkSheet -- so you need to go through the appropriate Sheet object
Note that you can do this directly without a loop
As formula
Worksheets(d).Cells(x, 5).Resize(J - 3 + 1, 1).FormulaR1C1 = "=MAX(Data!R[1]C5:R[" & J - 3 + 1 & "]C5)"
As values
Worksheets(d).Cells(x, 5).Resize(J - 3 + 1, 1).Value = "=MAX(Data!R[1]C5:R[" & J - 3 + 1 & "]C5)"