I have the following code that I assume has several issues. I need it to input different values in two cells based off of a CheckBox.
Sub YesNoChkBox()
Dim ChkBx As CheckBox, g As Integer, h As Integer, r As Integer
Set ChkBx = ActiveSheet.CheckBoxes(Application.Caller)
With ChkBx.TopLeftCell
r = .Row
g = .Column + 2
h = .Column + 3
End With
If ChkBx = 1 Then
gr = "NO"
hr = "NO"
Else
gr = "YES"
hr = ""
End If
End Sub
I need the checkbox to input NO, NO into the two cells (2 and 3 columns over) if checked, and YES, BLANK ("") if unchecked respectively.
The reason I am using r,g,h is because I would like to just copy and paste the checkbox to different rows and have it automatically populate the corresponding cell (which will always be column G:H but rows 5:21)
Do you mean this?
If ChkBx = 1 Then
Cells(r, g) = "NO"
Cells(r, h) = "NO"
Else
Cells(r, g) = "YES"
Cells(r, h) = ""
End If
Related
I need to fill in Col H (see red text in image for an example) as follows:
There are 3 subjects listed (separated by grey background) (Col C for number)
Each subject has multiple data points (one per row-Col D for data point "name")
(not shown) each subject multiple data points is run on multiple tests and sorted by test, subject, timepoint. (See Col E for Test), which means each "unifying ID"/"Subject ID" is used more than once. This data should be considered separately (for example, subject 8 Adiponectin results should not be compared with subject 8 Areg data)
Some of the data is not detected by the test and is marked in both Col J ("<LLOQ") and Col I ("Yes" for <LLOQ aka not detected).
I need help designing a program that answers if "all samples from this subject (and test) are below LLOQ?". Thus the program needs to detect that each subject's data must be viewed in a chunk fill out Col H "All Samples below LLOQ?" before moving on to the next subject. If there are no <LLOQ samples in the range, then each cell in Col H will be "No". If there are some samples <LLOQ and some samples that are NOT <LLOQ, then each cell in Col H within the range will be "No" (see grey subject). However, if All samples for a subject are <LLOQ, then the values in H must be "Yes" for all cells within the range.
In another Sub() I figured out how to reset values for each new subject using "C01D01.00" as a reset cue. This works to fill in data that is not reliant on the cells in a range (such as "Is the Baseline below LLOQ?" in col G. But I cannot figure out how to "set" a range, read through the range, identify if any cells are "no" in Col I and then return "no" in Col H (or "yes" in Col H if there are no "no" in Col I with in the range, and then move onto the next "range"). Ideas?
See below for how I programmed Col G.
Sub BaselineBelowLLOQ()
Sheets("Cyt-Data").Activate
Dim NewSubject As String
Dim SubjectBL As String
Dim BaselineRow As Integer
For i = 2 To 1000000
If Sheets("Cyt-Data").Cells(i, 2).Value = "" Then
Exit For
End If
NewSubject = Cells(i, 3).Value
If Not SubjectBL = NewSubject And Cells(i, 4).Value = "C01D01.00" Then
SubjectBL = NewSubject
BaselineRow = i
ElseIf Not SubjectBL = NewSubject And Not Cells(i, 4).Value = "C01D01.00" Then
SubjectBL = ""
End If
If Not SubjectBL = "" Then
If Cells(BaselineRow, 9).Value = "Yes" Then
Cells(i, 7).Value = "Yes"
Else
Cells(i, 7).Value = "No"
End If
End If
Next i
End Sub
Something like this should work:
Sub BaselineBelowLLOQ()
Dim ws As Worksheet, i As Long, dict As Object, k As String
Dim subjId, testName, num1 As Long, num2 As Long
Set dict = CreateObject("scripting.dictionary")
Set ws = ThisWorkbook.Worksheets("Cyt-Data") 'or ActiveWorkbook...
For i = 2 To ws.Cells(Rows.Count, "B").End(xlUp).Row
subjId = ws.Cells(i, "C").Value
testName = ws.Cells(i, "E").Value
k = subjId & "<>" & testName 'SubjectId<>TestName combination
If Not dict.exists(k) Then 'new combination?
'count all rows for this combo
num1 = Application.CountIfs(ws.Columns("C"), subjId, _
ws.Columns("E"), testName)
'count rows for this combo with "Yes" in Col I
num2 = Application.CountIfs(ws.Columns("C"), subjId, _
ws.Columns("E"), testName, _
ws.Columns("I"), "Yes")
dict.Add k, IIf(num1 = num2, "Yes", "No") 'compare counts for this combo
'and store the Yes/No outcome
End If
'tag the row using the value we already figured out
ws.Cells(i, "H").Value = dict(k)
Next i
End Sub
I am trying to write code that takes filtered criterium in column H (Associated work flow) from table below and than sums column G (Celková výše výnosu v EUR) according to columns C (Outbound/Inbound) and I (Úspěšně předáno) and place final number to Cell K3 by pressing button (Spustit).
I think it should work like this, i choose criterium in column H, for example Jade&Fountain, it will show me only rows that includes Jade&Fountain, i will press the button, and it will sum only those with Yes in column I + if there is I in column C, it will subtract from the total, if there is O, it will add to the total. Then it will show the total in Cell K3.
I add code i wrote, it should work, but i am not sure in the Do While Cells(i,2).SpecialCells(xlCellTypeVisible).Value <> "" section. Thanks for any response.
Sub While_loop()
Dim i As Integer
Dim x As Integer
i = 3
x = 0
Do While Cells(i, 2).SpecialCells(xlCellTypeVisible).Value <> ""
If Cells(i, 9).Value = "Yes" Then
If Cells(i, 3).Value = "O" Then
x = x + Cells(i, 7).Value
End If
If Cells(i, 3).Value = "I" Then
x = x - Cells(i, 7).Value
End If
End If
i = i + 1
Loop
Cells(2, 12).Value = x
End Sub
Table i am refering to
You can do that without VBA if you want to, following this tutorial https://exceljet.net/formula/count-visible-rows-only-with-criteria
Try this function (assuming data in row 3-15), the key is the SUBTOTAL function:
=SUMPRODUCT((C3:C15="O")*(I3:I15="Yes")*(SUBTOTAL(109,OFFSET(G3:G15,ROW(G3:G15)-MIN(ROW(G3:G15)),0,1))))
That gives the sum of all visible rows with your 2 criteria. If you want to deduct the I :
=SUMPRODUCT((C3:C15="O")*(I3:I15="Yes")*(SUBTOTAL(109,OFFSET(G3:G15,ROW(G3:G15)-MIN(ROW(G3:G15)),0,1))))-SUMPRODUCT((C3:C15="I")*(I3:I15="Yes")*(SUBTOTAL(109,OFFSET(G3:G15,ROW(G3:G15)-MIN(ROW(G3:G15)),0,1))))
I have two columns, the first one is a date with Year/Month format and the other a numerical value of an evaluation that i have done. I want to get the average value for each month with a macro( i need to do it so many times an a lot of data on it). So, i decided to create an array of dates and a Matrix of evaluation results. The goal is to group all numeric values by date and get the average per month. The problem is that this code ignores the value when the actual and last cells are different.
Dim i As Integer 'number of rows
Dim J As Integer 'manage row change
Dim G As Integer 'manage column change
Dim Fecha(48) As String
Dim Matriz_FI(100, 100) As Double
'-------------------------------------------------------------- --
J = 0
G = 0
For i = 2 To 10
If i = 2 Then
Matriz_FI(J, G) = Sheets("Nueva Database").Cells(i, 11).Value
Fecha(J) = Sheets("Nueva Database").Cells(i, 3).Value
G = G + 1
Else
If (Sheets("Nueva Database").Cells(i, 3).Value = Sheets("NuevaDatabase").Cells(i - 1, 3).Value) Then
'Column change in Matriz_FI
Matriz_FI(J, G) = Sheets("Nueva Database").Cells(i, 11).Value
G = G + 1
MsgBox ("Same")
Else
'Row change in Matriz_FI
J = J + 1
Fecha(J) = Sheets("Nueva Database").Cells(i, 3)
G = 0
Matriz_FI(J, G) = Sheets("Nueva Database").Cells(i, 11).Value
MsgBox ("Different")
End If
End If
Next
End Sub
We have prefix defined already (say ABC, GIJ, THK, JLK ...so on) and want to create a sequential number when a user wants to generate a number for each of these prefix like given below:
ABC0000 , ABC0001 , ABC0002 ...ABC9999 same for GIJ0000 , GIJ0001 , GIJ0002 ...GIJ9999.
Given below is the code written for the above logic, but it does not achieve the requirement:
Private Sub CommandButton1_Click()
With ComboBox1.Value
Dim a, b As String
Dim i, j, k, l, x, q, m, temp As Long
a = ComboBox1.Text
i = Application.WorksheetFunction.Match(a, Range("A1:A1000"), 0)
j = Cells(i, 2)
l = j * 1000
For q = 2 To 100
For m = 2 To 100
If Cells(q, m).Value < 0 Then
k = m
End If
Next
Next
x = l
If Cells(i, GC).Value = temp Then
click = click + 1
Else
click = 0
End If*
Cells(i, GC) = x + click
TextBox1.Text = x + click
temp = Cells(i, GC).Value
End With
GC = GC + 1
End Sub
VBA does not seem necessary for this. Assuming you have your prefixes in separate cells in ColumnA starting in Row1, put in B1:
=A1&TEXT(COUNTIF(A$1:A1,A1)-1,"0000")
and double-click its fill handle.
From your code, I assume that you have a ComboBox named ComboBox1, a CommandButton named CommandButton1 and a TextBox named TextBox1, all on a UserForm, and with ComboBox1 filled with the possible values for prefixes.
The following code will put the next available code(1) for the selected prefix into the TextBox.
Private Sub CommandButton1_Click()
Dim a As String
Dim i As Long, j As Long
a = ComboBox1.Text
i = Application.WorksheetFunction.Match(a & "9999", Range("A1:A1000"), 1)
j = CLng(Mid$(Cells(i, 1).Value, Len(a) + 1)) + 1
TextBox1.Text = a & Format(j, "0000")
End Sub
Your code is also doing a lot of unnecessary stuff.
(1) only if data is sorted.
It's been 6 years since I've worked with Excel and i'm a little bit rusty. Here's my scenario:
I am exporting a list of issues to Excel. I need to be able differentiate the associated Link numbers in a cell (mulitple values) from each other. Example, i have two columns,
Key = the number for a ticket
Linked Issues = The Keys associated
I need a statement that would scan the Key column and find a match in the Linked Issues column. Then once the match is found the matching text will assume the font color of the Key.
Where this get complicated is each cell of the Linked Issues column could look something like this iss-3913, iss-3923, iss-1649. So essentially the scan would be for a match within the string. Any help is appreciated.
I am sorry, I don't have time to finish this right now, but wWould something like this help with maybe a loop for each cell in the first column?
Edit: Finished now, second edit to update to B5 and Z5, edit 3 fixed goof with column reference and updated to use variables to assign what column to look in.
Sub colortext()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
o = start_row 'start with row one for second column
Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then 'if cell contents found in cell
With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
.Color = Cells(i, key_col).Font.Color 'change color of this part of the cell
End With
End If
o = o + 1 'increment the cell in second column
Loop
i = i + 1 'increment the cell in the first column
Loop
End Sub
or maybe
Something like this?
Excel VBA: change font color for specific char in a cell range
This is an old post but I thought I would provide my work around to the conditional formating issue I was having.
Sub colorkey()
start_row = 5
key_col = 2
flag_col = 4
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
Tval = Cells(i, flag_col).Value
Select Case Tval
Case "Requirement"
'cval = green
cVal = 10
Case "New Feature"
'cval = orange
cVal = 46
Case "Test"
'cval = lt blue
cVal = 28
Case "Epic"
'cval = maroon
cVal = 30
Case "Story"
'cval = dk blue
cVal = 49
Case "Theme"
'cval = grey
cVal = 48
Case "Bug"
'cval = red
cVal = 3
Case "NOT MAPPED"
'cval = Maroon
cVal = 1
End Select
Cells(i, key_col).Font.ColorIndex = cVal
i = i + 1 'increment the cell in the first column
Loop
End Sub
Sub colorlinked()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
o = start_row 'start with row one for second column
Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then 'if cell contents found in cell
With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
.Color = Cells(i, key_col).Font.Color 'change color of this part of the cell
End With
End If
o = o + 1 'increment the cell in second column
Loop
i = i + 1 'increment the cell in the first column
Loop
MsgBox "Finished Scanning"
End Sub