I have these in a worksheet
Then on a userform, I want that as I change the chapter, the No. part automatically updates that if on the worksheet, Chapter 1 last No. is 1 so No. on the userform automatically updates to 2, then same with Chapter 2 and 3.
This is what I tried:
Dim label As Control
For ctr = 1 To InfoForm.Chapter.ListCount - 1
For Each label In InfoForm.Controls
If TypeName(label) = "Label" Then
i = i + 1
Dim WhatChapter As String
WhatChapter = InfoForm.Chapter
lastNum = Cells(.Rows.Count, "A").End(xlUp).Row
If WhatChapter = "Chapter " & ctr Then
If Cells(lastNum, i).Value = "No." Then
Num.Value = 1
Else
Num.Value = Cells(lastNum, i).Value
End If
End If
End If
Next
Next ctr
Related
I am trying to make an auto scheduling program with an excel.
For example, each number is certain job assigned to the person given day.
1/2 1/3 1/4 1/5
Tom 1 2 2 ?
Justin 2 3 1 ?
Mary 3 3 ?
Sam 1 ?
Check O O X ? ## check is like =if(b2=c2,"O","X")
The things I want to make sure is every person is given a different job from yesterday.
My idea
while
randomly distribute jobs for 1/5
wend CheckCell = "O"
But I found that checking cell in the vba script doesn't work - the cell is not updated in each while loop.
Could you give me a little pointer for these kinds of program? Because I am new to vbaScript, any kinds of help would be appreciated.
Using VBA, I'm sure there are better ways to do this, but this will check the values from the penultimate column against values from last column and if they match it will write "O" to under the last column, else it will write "X":
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
counter = 0 'set counter
For i = 2 To LastRow 'loop through penultimate column and add values to array
If ws.Cells(i, LastCol - 1).Value <> "" Then
Values = Values & ws.Cells(i, LastCol - 1) & ","
End If
Next i
Values = Left(Values, Len(Values) - 1)
Values = Split(Values, ",") 'split values into array
For i = 2 To LastRow 'loop through last column and add values to array
If ws.Cells(i, LastCol).Value <> "" Then
ValuesCheck = ValuesCheck & ws.Cells(i, LastCol) & ","
End If
Next i
ValuesCheck = Left(ValuesCheck, Len(ValuesCheck) - 1)
ValuesCheck = Split(ValuesCheck, ",")
For y = LBound(Values) To UBound(Values) 'loop through both arrays to find all values match
For x = LBound(ValuesCheck) To UBound(ValuesCheck)
If Values(y) = ValuesCheck(x) Then counter = counter + 1
Next x
Next y
If counter = UBound(Values) + 1 Then 'if values match
ws.Cells(LastRow + 1, LastCol).Value = "O"
Else 'else write X
ws.Cells(LastRow + 1, LastCol).Value = "X"
End If
End Sub
just to clarify are you looking to implement the random number in the vba or the check.
To do the check the best way would be to set the area as a range and then check each using the cells(r,c) code, like below
Sub checker()
Dim rng As Range
Dim r As Integer, c As Integer
Set rng = Selection
For r = 1 To rng.Rows.Count
For c = 1 To rng.Columns.Count
If rng.Cells(r, c) = rng.Cells(r, c + 1) Then
rng.Cells(r, c).Interior.Color = RGB(255, 0, 0)
End If
Next c
Next r
End Sub
this macro with check the text you have selected for the issue and change the cell red if it matches the value to the right.
To make it work for you change set rng = selection to your range and change the rng.Cells(r, c).Interior.Color = RGB(255, 0, 0) to the action you want
A sligthly different approach than the other answers.
Add this function:
Function PickJob(AvailableJobs As String, AvoidJob As String)
Dim MaxTries As Integer
Dim RandomJob As String
Dim Jobs() As String
Jobs = Split(AvailableJobs, ",")
MaxTries = 100
Do
MaxTries = MaxTries - 1
If MaxTries = 0 Then
MsgBox "Could find fitting job"
End
End If
RandomJob = Jobs(Int((1 + UBound(Jobs)) * Rnd()))
Loop Until RandomJob <> AvoidJob
PickJob = RandomJob
End Function
And put this formula in your sheet
=PickJob("1,2,3",D2)
where D2 points to is the previous job
I'm trying to create an array of option buttons (or check boxes if you find that works better) where only one option can be selected in each row and column.
I'm trying to do this so that a user can choose an order in which a certain list goes.
The following code takes the column headers in an excel sheet, and creates bunch of option buttons x columns across and x rows down.
Sub Option_Buttons()
Dim str As String
lCol = Sheets("Headers").UsedRange.Columns.Count
Dim OpBtn() As OptionButton
ReDim OpBtn(lCol, lCol) As OptionButton
Dim GrBx() As GroupBox
ReDim GrBx(lCol) As GroupBox
Dim i
Dim j
'
For i = 1 To lCol
Set GrBx(i) = Sheets("OPBTN").GroupBoxes.Add(Cells(i, 1).Left, _
Cells(i, 1).Top, lCol * 50, 17.25)
With GrBx(i)
.Caption = ""
'.Visible = False
End With
For j = 1 To lCol
Set OpBtn(i, j) = Sheets("OPBTN").OptionButtons.Add _
(Cells(i,j).Left, Cells(i, j).Top, 72, 17.25)
str = Sheets("Turf").Cells(1, j)
check = OpBtn(i, j).Value
With OpBtn(i, j)
.Caption = str
.Value = xlOff '
.LinkedCell = "'OData'!" & Sheets("OData").Cells(i, 1).Address
.Display3DShading = False
End With
Next
Next
End Sub
Is there any way I can make it so that only one option can exist in each row AND column? (so if there are 5 column headers, there are 25 option buttons of which only 5 can be selected).
Is there any way to deal with the option that a user doesn't want a header selected?
I'm trying to avoid all possible uses of the controls tab because this is part of a macro that needs to be used by completely excel illiterate people and needs to be applied to highly variable
I was able to accomplish this using checkboxes. The key was to name the checkboxes using R1C1 notation and assigning a macro (ManageCheckBoxes) to all the checkboxes. After identifying what checkbox was clicked using Application.Caller I iterate over all the checkboxes parsing their names to identify which rows and columns they are in.
Sub Option_Buttons()
Dim str As String
Dim r As Integer, c As Integer
Dim check As CheckBox
lCol = Sheets("Headers").UsedRange.Columns.Count
With Sheets("OPBTN")
For r = 1 To lCol
For c = 1 To lCol
Set check = .CheckBoxes.Add(.Cells(r, c).Left, .Cells(r, c).Top, 72, 17.25)
str = Sheets("Turf").Cells(r, c)
With check
.Caption = str
.Value = xlOff '
.Name = "R" & r & "C" & c
.Display3DShading = False
.OnAction = "ManageCheckBoxes"
End With
Next
Next
End With
End Sub
Sub ManageCheckBoxes()
Dim arrCaller As Variant, arrCheck As Variant
Dim check As CheckBox, ckCaller As CheckBox
arrCaller = getRC(Application.Caller)
With Sheets("OPBTN")
Set ckCaller = .CheckBoxes(Application.Caller)
For Each check In .CheckBoxes
If ckCaller.Name <> check.Name Then
If check.Name Like "R#*C#*" Then
arrCheck = getRC(check.Name)
If arrCheck(0) = arrCaller(0) Or arrCheck(1) = arrCaller(1) Then
check.Value = False
End If
End If
End If
Next
End With
End Sub
Function getRC(sName As String)
Dim a(1) As Long
Dim arr As Variant
arr = Split(sName, "C")
a(0) = Right(arr(0), Len(arr(0)) - 1)
a(1) = arr(1)
getRC = a
End Function
use GroupName property of option buttons. GroupName property determines the group of option button. user will be able to select only one option button from the group.
Set same groupname for your five option buttons and same for other five.
For Example :
Option1 GroupName: grp1
Option2 GroupName: grp1
Option3 GroupName: grp2
Option4 GroupName: grp2
in the above case user will be able to select one from option1 and option2. one button from option3 and option4.
I have 3 combo boxes on a form. The first is populated when the form loads, the second is populated when the user picks a value from the first combo box, and the third is populated when the user picks a value from the second.
When the third combo box is changed, I am using a nested If statement to determine what row this combination lies in (so I can populate textboxes on the form). However, the first If Statement is failing to trigger (i.e. return a 'true' value). There is an acceptable value in the cell, so it should progress to the next If statement, but it just jumps to the end of my While statement.
Private Sub cmb_State_Change()
Dim Project, licence, state As String
Dim selectedrow As Integer
Dim LastRow As Integer
Dim i, j As Integer
selededrow = 0
Project = cmb_Project.Value
licence = cmb_Licence.Value
state = cmb_State.Value
i = 1
j = 3
While selectedrow = 0
If Worksheets("Entitlements").Cells(i, j) = Project Then
i = i + 6
If Worksheets("Entitlements").Cells(i, j) = licence Then
i = i - 1
If Worksheets("Entitlements").Cells(i, j) = state Then
selectedrow = j
End If
End If
Else
j = j + 1
i = i - 5
End If
Wend
End Sub
Can anybody see why it would be behaving like this?
Cells takes its arguments as rows then columns so you need to reverse i and j in your code. When you do Range("C4") it is columns then rows i.e. column C, row 4 - but Cells is the other way around.
So, currently you have
If Worksheets("Entitlements").Cells(i, j) = Project Then
i = i + 6
If Worksheets("Entitlements").Cells(i, j) = licence Then
i = i - 1
If Worksheets("Entitlements").Cells(i, j) = state Then
selectedrow = j
Which is making your second lookup 6 rows down - not 6 columns across.
Rewrite those as:
If Worksheets("Entitlements").Cells(j, i) = Project Then
i = i + 6
If Worksheets("Entitlements").Cells(j, i) = licence Then
i = i - 1
If Worksheets("Entitlements").Cells(j, i) = state Then
selectedrow = j
Another option
You can just rewrite the code block as this:
r = 3
While selectedrow = 0
If Worksheets("Entitlements").Cells(r, 1) = Project And _
Worksheets("Entitlements").Cells(r, 7) = licence And _
Worksheets("Entitlements").Cells(r, 6) = State Then
selectedrow = r
Else
r = r + 1
End If
Wend
An even better option
Using the While..Wend loop means the code will run to the last row (over million rows) in the sheet if there is no match. You can use a standard bit of code to find the last row in your data:
Set ws = Worksheets("Entitlements")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Then use a For..Next loop over that range. For example:
Option Explicit
Private Sub cmb_State_Change()
Dim Project As String, licence As String, state As String
Dim selectedrow As Integer
Dim LastRow As Integer
Dim r As Integer
Dim ws As Worksheet
selectedrow = 0
Project = "hello" 'cmb_Project.Value
licence = "world" 'cmb_Licence.Value
state = "stuff" 'cmb_State.Value
Set ws = Worksheets("Entitlements")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For r = 3 To LastRow
If ws.Cells(r, 1) = Project And _
ws.Cells(r, 7) = licence And _
ws.Cells(r, 6) = state Then
selectedrow = r
Exit For
Next r
End Sub
Note the use of Option Explicit to catch any typos in your code. In your original question you had Dim selectedrow As Integer and selededrow = 0 which would have thrown a compile time error if you were using `Option Explicit'.
I am using around 8-10 comboboxes(form control),each one having the same list of items populated. Based on the user's selection from the dropdown, a certain value is displayed in a different cell. I wanted to know if there is way to do this without using a loop(for dropdowns) as all have the same function. Here is the code I am using:
Dim ws As Sheets
Set ws = ThisWorkbook.Sheets(Array("S1 Fuel Consumption", "EF_Stat", "Summary"))
Dim i As Integer
For i = 1 To 8
With ws(1).Shapes("Fuel " & i).ControlFormat ~~> 'This is the loop I'm talking about(for 8 shapes)
Select Case .ListIndex
Case 1
ws(3).Range("B" & i).Value = Empty
Case 2
ws(3).Range("B" & i).Value = ws(2).Range("B4").Value
Case 3
ws(3).Range("B" & i).Value = ws(2).Range("C4").Value
Case 4
ws(3).Range("B" & i).Value = ws(2).Range("D4").Value
End Select
End With
Next i
Assign the same macro to all of the comboboxes and use:
With WS(1).Dropdowns(Application.Caller)
to get a reference to the combobox that triggered the macro.
If you need to figure out the 'i' value you were using in the loop originally, you can do something like this:
Dim ws As Sheets
Dim sCaller As String
Dim i As Integer
Dim rgOutput As Range
Set ws = ThisWorkbook.Sheets(Array("S1 Fuel Consumption", "EF_Stat", "Summary"))
sCaller = Application.Caller
Set rgOutput = ws(3).Range("B" & Replace(sCaller, "Fuel ", ""))
Select Case ws(1).DropDowns(sCaller).ListIndex
Case 1
rgOutput.Value = vbNullString
Case 2
rgOutput.Value = ws(2).Range("B4").Value
Case 3
rgOutput.Value = ws(2).Range("C4").Value
Case 4
rgOutput.Value = ws(2).Range("D4").Value
End Select
I am getting the 1004 error when running. The error is at this line:
If IsNumeric(wkbCurr.Sheets(CTRYname).Range(column & x).Value) = True Then
What I want to do is to select the sheet (CTRYNAME) and then search through columns 5,7,9 etc and format the numbers as done in the code.
Public Sub MoM_Check()
Dim inti As Integer
Dim intj As Integer
Dim k As Integer
Dim mnth As Integer
Dim currSALE As Double
Dim prevSALE As Double
Dim diffpercent As Double
Dim CTRYname As String
Dim x As Integer
Dim column As String
'Find Difference percentage between sales of 24 common months in present month's extarct and previous month's extract
For n = 1 To 13
Application.SheetsInNewWorkbook = 4
Set wkbTemp = Workbooks.Add
CTRYname = ThisWorkbook.Sheets("Country lookup").Range("A1").Offset(n, 0).Value
'Open a temporary workbook to do all the Calculations
'First the current month's extract is copied to the first sheet
'We now copy sheets for range from wkbout to wkbtemp using usedrange
wkbCurr.Sheets(CTRYname).Activate
wkbCurr.Sheets(CTRYname).UsedRange.Copy
wkbTemp.Sheets("Sheet1").Range("A1").PasteSpecial
wkbprev.Sheets(CTRYname).Activate
wkbprev.Sheets(CTRYname).UsedRange.Copy
wkbTemp.Sheets("Sheet2").Range("A1").PasteSpecial
'open the Previous month's Main Extract file as given in the lookup tab. This data is pasted on sheet2 of temporary workbook.
'This sheet helps us to compare the country channels in current month's extract with the previous Month's Extract.
'So the same process is followed for this sheet and similarly we get the country channels from the previous month's extract and paste them on 'sheet3
'Prevcnt contains the number of country channels in the previous month's extract
k = 1
For mnth = 0 To 22
currSALE = wkbTemp.Sheets("Sheet1").Range("AB10").Offset(0, mnth).Value
prevSALE = wkbTemp.Sheets("Sheet2").Range("AC10").Offset(0, mnth).Value
If prevSALE = 0 And currSALE <> 0 Then
diffpercent = 1
ElseIf prevSALE = 0 And currSALE = 0 Then
diffpercent = 0
Else: diffpercent = (currSALE - prevSALE) / prevSALE
End If
If diffpercent > 0.01 Or diffpercent < -0.01 Then
Set wkbRaw = Workbooks.Open(strOutputQCPath & "Errorlog.xlsx")
wkbRaw.Sheets("Sheet1").Activate
wkbRaw.Sheets("Sheet1").Range("A1").Offset(i, 1 + n).Value = CTRYname & " Incorrect"
Exit For
Else
Set wkbRaw = Workbooks.Open(strOutputQCPath & "Errorlog.xlsx")
wkbRaw.Sheets("Sheet1").Activate
wkbRaw.Sheets("Sheet1").Range("A1").Offset(i, 1 + n).Value = CTRYname & " Correct"
k = k + 1
wkbRaw.SaveAs Filename:=strOutputQCPath & "Errorlog.xlsx"
wkbRaw.Close
End If
Next mnth
For x = 1 To 15
If x = 1 Or x = 2 Or x = 3 Or x = 4 Or x = 6 Or x = 9 Or x = 10 Or x = 11 Or x = 13 Then
GoTo Name
Else
If IsNumeric(wkbCurr.Sheets(CTRYname).Range(column & x).Value) = True Then
If wkbCurr.Sheets(CTRYname).Range(column & x).Value > 9.99 Then
wkbCurr.Sheets(CTRYname).Range(column & x).Value = ">999%"
ElseIf wkbCurr.Sheets(CTRYname).Range(column & x).Value < -9.99 Then
wkbCurr.Sheets(CTRYname).Range(column & x).Value = "<-999%"
End If
End If
End If
Name:
Next x
wkbTemp.Close savechanges:=False
Set wkbTemp = Nothing
Next n
End Sub
Please help!
You haven't given the string "column" a value, which is why you're getting error 1004 on that line.