I want to build a survey using excel and vba. I have a table with questions and answers. As the survey starts, my code will list the answers by overwriting the checkboxes' labels on a form. I will fetch their answer and write them in a column by using True or False value of a checkbox.
Variable "aRow" is the number of the answers for each question. "lastAns" is the row number of the last answer. Depending on the number of the answer, some checkboxes will be hidden, shown. "CheckBox1" to "CheckBox4" are the names of the checkboxes.
The following code works, but it is too long and I want to have a better method to loop through the checkboxes and changing their labels each time. Please show me how to do it!
Thanks you so much!
`lastAns = Cells(qRow, 5).End(xlDown).Row + 1
aRow = lastAns - qRow
If aRow >= 1 Then
Me.CheckBox1.Visible = True
Me.CheckBox1.Caption = Cells(qRow, 5)
Else: Me.CheckBox1.Visible = False
End If
If aRow >= 2 Then
Me.CheckBox2.Visible = True
Me.CheckBox2.Caption = Cells(qRow + 1, 5)
Else: Me.CheckBox2.Visible = False
End If
If aRow >= 3 Then
Me.CheckBox3.Visible = True
Me.CheckBox3.Caption = Cells(qRow + 2, 5)
Else: Me.CheckBox3.Visible = False
End If
If aRow >= 4 Then
Me.CheckBox4.Visible = True
Me.CheckBox4.Caption = Cells(qRow + 3, 5)
Else: Me.CheckBox4.Visible = False
End If
.....SAME CODE CONTINUES TILL 7...`
As a follow up answer to my comment, here is what I think you are looking for:
arow = lastAns - qRow
Dim i As Long, ctl As Control
For i = 1 To 4
Set ctl = Me.Controls("CheckBox" & i)
If i <= arow Then
ctl.Visible = True
ctl.Caption = Cells(qRow + i - 1, 5)
Else
ctl.Visible = False
End If
Next i
Related
I am attempting to create an Auto-grading test of sorts in Excel.
I have 5 values in Sheet1 that are input by a user in cells E5:E9. These should then be compared against a range of 5 more cells in Sheet2 (also cells E5:E9).
As the user might not always list these entries in the same order that I have in my Sheet2 range, I decided that I should loop through the range for each cell's input.
The next step would be to be able to ignore the value in the range once a match has been found but I need to get this part working correctly. Currently, the values absolutely match. However, I am not getting the correct output.
Sub Q1()
Dim i As Integer
For i = 5 To 9
If (Sheet1.Cells(5, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(6, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(7, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(8, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(9, 5) = Sheet2.Cells(i, 5)) Then
Sheet1.Cells(5, 6) = 1
Exit For
Else
Sheet1.Cells(5, 6) = 0
End If
Next
End Sub
I would expect the output of 1 to Sheet1 cell E6 but I am currently getting 0. Thanks!
Little Complex :)
Sub Q1()
Dim i As Integer
Dim j As Integer
Dim chck(5 To 9) As Boolean
For i = 5 To 9
For j = 5 To 9
If Sheet1.Cells(i, 5) = Sheet2.Cells(j, 5) Then
chck(i) = True
Exit For
Else: chck(i) = False
End If
Next
Next
j = 0
For i = LBound(chck) To UBound(chck)
If chck(i) = True Then j = j + 1
Next
If j = 5 Then
Sheet1.Cells(5, 6) = 1
Else: Sheet1.Cells(5, 6) = 0
End If
End Sub
Does this really need to be VBA? A formula can perform this calculation. Use this in 'Sheet1' cell F5:
=--(SUMPRODUCT(COUNTIF(Sheet2!E5:E9,E5:E9))>0)
If at least one of the values in 'Sheet1'!E5:E9 (the user entered values) exists in your 'Sheet2'!E5:E9 list, the formula will return a 1 else 0 which is the desired result based on your description.
I am trying to extract a substring which has a random position from different strings. The substing is not a fixed value but a "T" and then four numberals e.g. T6000.
As you can see in this image there are a number of machines names where most of them contain a T number. The T number is also different in almost all of the cases. The column of the machines names is "E". First number (T6000) is in E16, last is in E25.
Using my code:
For Ipattern = 16 To NumofMachines + 15 Step 1
TNUMcell = Dsht.Range("E" & Ipattern).Value
'Verify if string contains a Tnum
TNUMLikeBoolean = TNUMcell Like "*T###*"
If TNUMLikeBoolean = True Then
Do Until TNUMdone = True
TNUMchar1 = InStr(TNUMcell, "T") + 1
TNUMcharV = Mid(TNUMcell, TNUMchar1)
TNUMchecknum = IsNumeric(TNUMcharV)
If TNUMchecknum = True Then
Dsht.Range("F" & Ipattern).Value = "T" & Mid(TNUMcell, TNUMchar1, 5)
TNUMdone = True
End If
Loop
Else
Dsht.Range("F" & Ipattern).Value = "NO T"
End If
Next Ipattern
It only fills in the first and the last cell of the 'export' range (F16:F25).
I have been searching for an answer quite some time. As I am (obviously) not a VBA expert.
What am I doing wrong? Why is not filling in the other values?
Thanks,
Wouter J
Try this code
Sub Test()
Dim r As Range, i As Long, c As Long
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "T\d{4}"
For Each r In Range("E16", Range("E" & Rows.Count).End(xlUp))
c = 6
If .Test(r.Value) Then
For i = 0 To .Execute(r.Value).Count - 1
Cells(r.Row, c).Value = .Execute(r.Value)(i)
c = c + 1
Next i
End If
Next r
End With
End Sub
The problem is with your variable TNUMdone.
This is set to True on the first iteration of the loop and then never again set to False, so this code after Do Until TNUMdone = True never runs again.
At the start of your loop, just set TNUMdone to False and it should work:
For Ipattern = 16 To NumofMachines + 15 Step 1
TNUMdone = False
TNUMcell = Dsht.Range("E" & Ipattern).Value
...
I have more than 20 hidden columns with data. I want 4 columns to appear and then the next 4 columns on each click of a button.
I tried the below code. Instead of 4 columns at a time, it shows all 20 columns in a click.
Sub compare() '
'compare macro
'selects the button1 rows for the output tab
application.screenupdating=true
range("I10:AR62").entirecolumn/hidden=false
range("B1").select
application.screenupdating=false
End
you want something like:
range(columns(j),columns(j+k)).entirecolumn.hidden=true
range(columns(y),columns(y+z)).entirecolumn.hidden=false
but you need logic to determine what j is... first scenario is where nothing is hidden:
if not columns(9).entirecolumn.hidden and not columns(13).entirecolumn.hidden and not columns(17).entirecolumn.hidden and not columns(21).entirecolumn.hidden then
Then you will want to hide such that:
j = 13
k = 15
Where that scenario is not true (ELSE), you should have some logic embedded to determine what is hidden and unhide other sections:
if not columns(9).entirecolumn.hidden then
j = 9
k = 3
y = 13
z = 3
You would need the above for each of your column groupings to tell what isn't hidden, so you know what grouping is next.
You would have listed what sections will be visible and which sections would be hidden based on the column numbers.
I know it has been a few days since anyone has posted on this, but I figured I would post this part of a macro that I have built for another project. This should work as intended, and the variables are already setup according to the OP's question.
Sub DynHideColumns()
FirstColumn = 9 ' First Column that could be hidden
LastColumn = 200 ' Last Column that could be hidden
ColumnSteps = 4 ' Number of columns to hide per start
x = FirstColumn
Z = 1
ReDim y(1 To ColumnSteps)
Do Until x > LastColumn
If ActiveSheet.Range(Columns(x), Columns(x)).EntireColumn.Hidden = False Then
If Z <= ColumnSteps Then
y(Z) = x
Z = Z + 1
Else
y(1) = ""
End If
End If
x = x + 1
Loop
ActiveSheet.Range(Columns(FirstColumn), Columns(LastColumn)).EntireColumn.Hidden = True
If y(1) = "" Then
ActiveSheet.Range(Columns(FirstColumn), Columns(FirstColumn + ColumnSteps - 1)).EntireColumn.Hidden = False
Else
If y(ColumnSteps) = LastColumn Then
ActiveSheet.Range(Columns(FirstColumn), Columns(FirstColumn + ColumnSteps)).EntireColumn.Hidden = False
Else
ActiveSheet.Range(Columns(y(1) + ColumnSteps), Columns(y(ColumnSteps) + ColumnSteps)).EntireColumn.Hidden = False
End If
End If
End Sub
I'm trying to define some variables (for row/column referencing) and use it in multiple subs but I'm having some issue:
Update - fixed earlier issue. Now I can get the columns to cycle. However , when the Column AE is visible and someone clicks next, I want the process to hide the current row, reset to Column E i.e. 5, and show the next row, then cycle through to column AE again. At the moment, when I click 'Next' when AE is showing, it just hides the current row and doesn't show the next row or hid the columns D:AE....
The code it's working from is:
If Columns("AE:AE").EntireColumn.Hidden = False Then
Columns("D:AE").EntireColumn.Hidden = True
Rows(Question).EntireRow.Hidden = True
Question = Question + 1
Rows(Question).EntireColumn.Hidden = False
Brand = 5
End If
Full code here:
Public Brand As Integer
' this will hold the current visible column
Public Question As Integer
' this will hold the current visible row
Sub StartQuestionnaire()
' this sends the user to two different questionnaire formats
If ThisWorkbook.Team = 1 Then Call BrandManager
If ThisWorkbook.Team = 0 Then Call CrossFunctionalTeam
End Sub
Sub BrandManager()
'Questionnaire format 1
Brand = 5
Question = 10
Columns(Brand).EntireColumn.Hidden = False
Rows(Question).EntireRow.Hidden = False
End Sub
Sub CrossFunctionalTeam()
'Questionnaire format 2
If ThisWorkbook.Team = 0 Then
Columns("E:AE").EntireColumn.Hidden = False
Rows("10:10").EntireRow.Hidden = False
ActiveSheet.Range("E10").Select
End If
End Sub
Sub NextButton()
'if a Brand Manager, cycle to the next column question until column AE is reached, then move to next row and show first question only
If ThisWorkbook.Team = 1 Then
If Columns("AE:AE").EntireColumn.Hidden = False Then
Columns("D:AE").EntireColumn.Hidden = True
Rows(Question).EntireRow.Hidden = True
Question = Question + 1
Rows(Question).EntireColumn.Hidden = False
Brand = 5
End If
If Columns("AE:AE").EntireColumn.Hidden = True Then
Columns(Brand).EntireColumn.Hidden = True
Brand = Brand + 1
Columns(Brand).EntireColumn.Hidden = False
End If
End If
'if a Cross Funtional team user, Next button should cycle to the next row of questions
If ThisWorkbook.Team = 0 Then
Question = 10
Rows(Question).EntireRow.Hidden = True
Question = Question + 1
Rows(Question).EntireRow.Hidden = False
End If
End Sub
What do you want to say with Range(Row)? Say, Range(25)?
If I'm not misunderstanding and according to your code it must look as:
Sub NextButton()
' ...
If Range("AE:AE").EntireColumn.Hidden = False Then
' ...
Rows(Row).Hidden = True ' Range(Row).EntireRow.Hidden
Row = Row + 1
Columns(Row).Hidden = False ' Range(Row).EntireColumn.Hidden
' ...
I have a code that searches an excel fill for the word distance, takes the value of the cell next to it, paste it into a new cell, then sums all the cells up. Which works great, but i now need to find a way to only sum ever even row number. Does that make sense?
Sub Distance_Check()
Dim DistanceCheck As String
Dim DistanceNumber As String
Dim DistanceSum As String
Dim DistanceTotal As String
DistanceCheck = MsgBox("Would you like to check the distance?", vbYesNo)
If DistanceCheck = vbYes Then
If IsArray(fname) Then Workbooks.OpenText fname(1)
i = 1
findStr = "Distance"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("J" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
Set wkbSourceBook = ActiveWorkbook
DistanceNumber = i - 2
DistanceSum = WorksheetFunction.Sum(Range(Cells(2, 15), (Cells(DistanceNumber + 1, 15))))
DistanceTotal = DistanceSum / DistanceNumber
If DistanceNumber = Cells(2, 12) Then
MsgBox ("No error found wihin distance")
Else
MsgBox ("Error found with distance")
End If
Else
End If
Call Save_Data
End Sub
Would the way youd go about this be using a for loop on the
cells(DistanceNumber(j,+1)
Where j = 0,
j = j +2 ,
Until j > DistanceNumber,
Would that work? If so how would you go about it?
Thanks
A quick way to step through a loop in the desired increments is to use the Mod operator which divides two numbers and returns any remainder (e.g. 7 mod 2 = 1, as two sixes fit into seven, leaving one).
You can use the row property of the range you identify with the Find method, and since you want to jump by two the modulo should be zero:
If foundcel.Row Mod 2 = 0 Then Range("J" & i).value = foundcel.Offset(0, 1).Value
That said, there is a 'built in' way to step through a loop if using a For loop like this
For x = 2 to 10 Step 2
' Do stuff
Next x
You can also use this method to step backwards, e.g.
For x = 100 to 0 Step -10
' Do stuff backwards!
Next x