I'm trying to create a time line via Excel and VBA, having the hours (1-24) listed in the range A1:A24; I created a ComboBox, filled the list with that very range and now I'm trying to link these two, so that if I choose a certain hour in the ComboBox, Excel will display "Test" one cell to the right of that specific cell from the given range (e.g. if I select "8" in the ComboBox, then Excel will display "Test" in B8, since the value of A8 is "8")
This is how far I got with the little knowledge about VBA that I have:
Private Sub Combobox1_Change()
For Each cell In Range("A1:A24")
If cell.Value = Me.ComboBox1.Value Then
cell.Offset(0, 1).Value = "Test"
End If
Next
End Sub
It would be great if someone could help me work this out!
If the list is ordered 1 - 24, simply use
Private Sub ComboBox1_Change()
Dim MyRange As Range
Set MyRange = [A1] ' or wherever your list starts
MyRange(ComboBox1.Value, 2) = "Test" ' address the range object by row, column
End Sub
Be carefull with If cell.Value = Me.ComboBox1.Value Then ... ComboBox1 returns a String, your Cell may contain numbers and the If may not work (at least here this is the case).
A more generalized routine scanning the whole list and not relying on its ascending sort order (you may soon have a list with "Apple", "Banana", "Cherimoya", ...)
Private Sub ComboBox1_Change()
Dim MyRange As Range, Idx As Integer
Set MyRange = [A1] ' or whereever your list starts
Idx = 1
Do While MyRange(Idx, 1) <> "" ' start processing
If Str(MyRange(Idx, 1)) = Str(ComboBox1) Then
If MyRange(Idx, 2) = "" Then ' bonus: do a toggle
MyRange(Idx, 2) = "Test"
Else
MyRange(Idx, 2) = ""
End If
Exit Do ' or not for full list processing
End If
Idx = Idx + 1
Loop
End Sub
Related
I am trying to get my VBA to select values that are "0" in my table and clear the contents of that cell.
So far I have been able to get look up the table column I want to see.
Sheets("formulas").Select
Range("machine_schedule[days ]").Select
If the days are 0 Then ' <---- this is where I am having trouble.
cell.Clear
End If
It's advisable to avoid any kind of .Select when working with VBA. So the followinfg two lines are not needed (you can provide references without .Select).
Sheets("formulas").Select
Range("machine_schedule[days ]").Select
The following script checks every cell one by one in the provided range. If a zero is found, the cell is cleared. .Clear not only deletes the contents, it clears format too. If could use .ClearContents to only clear the contents.
Sub clear_zero()
Dim cell As Range
For Each cell In Sheets("formulas").Range("machine_schedule[days ]")
If cell.Value = 0 Then
cell.Clear
End If
Next
End Sub
If you only want to clear the 0 values from the cells you could try this.
Sub ClearZeroes()
Dim arrData As Variant
Dim idx As Long
With Sheets("formulas").Range("machine_schedule[days ]")
arrData = .Value
For idx = LBound(arrData, 1) To UBound(arrData, 2)
If arrData(idx, 1) = 0 Then
arrData(idxrow, 1) = ""
End If
Next idx
.Value = arrData
End With
End Sub
Can someone help me with retrieving the corresponding row and column when a range is selected via Refedit? I put the pictures below how it looks like.
What I want to do is when I select a range (for example E12:E16) via the "Refedit1" in my userform, it should return the start and end time for the corresponding row (11AM - 3PM +1) and the corresponding date in column (wednesday 26/02/2020)
Next step would be to insert these values immediately inside the 3 DTPickers but this I can do once I have the return values, I think.
I tried all different codes that I found and they always give me either the value that is in the cell ("" in this example), a text string like "sheet1$E$12 or when I use Active.Cell it returns the cell that was active before I selected my range through RefEdit.
Hopefully someone can point me in the right direction, I would help me a lot! Sorry that I couldn`t upload the original excel file but there was to many confidential info in it...
sheet layout
Userform layout
Private Sub CommandButton2_Click()
Dim rRange As Range
Dim strAddr As String
Dim bIsRange As Boolean
'Get the address, or reference, from the RefEdit control.
strAddr = RefEdit1.Value
'Use IsObject to find out if the string is a valid address.
On Error Resume Next
bIsRange = IsObject(Range(strAddr))
On Error GoTo 0
If bIsRange = False Then 'Not Valid
MsgBox "The range is not valid"
RefEdit1.Value = vbNullString
RefEdit1.SetFocus
Exit Sub
End If
'Set the rRange Range variable to the range nominated by the
'RefEdit control. If the Sheet name is also include (eg Sheet2!A1:A10)
'It will act on that range, even if the sheet is not active at the time.
Set rRange = Range(strAddr)
' gives the cell reference as a string
MsgBox strAddr
With rRange
'.Interior.ColorIndex = 16
.Font.Bold = True
'.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
End With
If strAddr = "" Then
'do nothing
Else
Range(strAddr).Value = UserForm1.ComboBox2.Value
End If
End Sub
You can read the date and times like this:
With rRange
'.Interior.ColorIndex = 16
.Font.Bold = True
'.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
startTime = .cells(1).EntireRow.cells(2).Value
endTime = .cells(.cells.count).EntireRow.cells(2).Value
theDate = .cells(1).EntireColumn.cells(5).Value
End With
I have a worksheet with 3 rows and 7 columns (A1:G3).
A and B columns have 6 checkboxes (A1:B3). Boxes in columns A & B are linked to columns C & D respectively. Cells in columns E & F are just replicating columns C & D respectively (live E1 cell is =C1 and F3 cell is =D3).
I want to put a timestamp in cell G for each row when a checkbox is ticked or unticked by using Worksheet_Calculate event in VBA for that sheet.
My code works when used for just 1 row.
Private Sub Worksheet_calculate()
Dim cbX1 As Range
Set cbX1 = Range("A1:F1")
If Not Intersect(cbX1, Range("A1:F1")) Is Nothing Then
Range("G1").Value = Now()
End If
End Sub
I want to combine the code for 3 rows.
Here are 2 variations:
1st one:
Private Sub Worksheet_calculate()
Dim cbX1 As Range
Dim cbX2 As Range
Dim cbX3 As Range
Set cbX1 = Range("A1:F1")
Set cbX2 = Range("A2:F2")
Set cbX3 = Range("A3:F2")
If Not Intersect(cbX1, Range("A1:F1")) Is Nothing Then
Range("G1").Value = Now()
ElseIf Intersect(cbX2, Range("A2:F2")) Is Nothing Then
Range("G2").Value = Now()
ElseIf Intersect(cbX3, Range("A3:F3")) Is Nothing Then
Range("G3").Value = Now()
End If
End Sub
When I combine them with ElseIf like in the code above, a timestamp gets put in only G1, no matter if I tick B1 or C2.
2nd one:
Private Sub Worksheet_calculate()
Dim cbX1 As Range
Dim cbX2 As Range
Dim cbX3 As Range
Set cbX1 = Range("A1:F1")
If Not Intersect(cbX1, Range("A1:F1")) Is Nothing Then
Range("G1").Value = Now()
End If
Set cbX2 = Range("A2:F2")
If Not Intersect(cbX2, Range("A2:F2")) Is Nothing Then
Range("G2").Value = Now()
End If
Set cbX3 = Range("A3:F2")
If Not Intersect(cbX3, Range("A3:F3")) Is Nothing Then
Range("G3").Value = Now()
End If
End Sub
When I combine them by ending each one with End If and start a new If, timestamp gets put in all of the G1, G2 and G3 cells, even if I tick just one of the boxes.
You seem to be confusing Worksheet_Calculate with Worksheet_Change and using Intersect as if one of the arguments was Target (which Worksheet_Calculate does not have).
Intersect(cbX1, Range("A1:F1")) is always not nothing because you are comparing six apples to the same six apples. You might as well ask 'Is 1,2,3,4,5,6 the same as 1,2,3,4,5,6?'.
You need a method of recording the values of your range of formulas from one calculation cycle to the next. Some use a public variable declared outside the Worksheet_calculate sub procedure; personally I prefer a Static variant array declared within the Worksheet_calculate sub.
The problem with these is initial values but this can be accomplished since workbooks undergo a calculation cycle when opened. However, it is not going to register Now in column G the first time you run through a calculation cycle; you already have the workbook open when you paste in the code and it needs one calculation cycle to 'seed' the array containing the previous calculation cycle's values.
Option Explicit
Private Sub Worksheet_Calculate()
Static vals As Variant
If IsEmpty(vals) Then 'could also be IsArray(vals)
vals = Range(Cells(1, "A"), Cells(3, "F")).Value2
Else
Dim i As Long, j As Long
With Range(Cells(1, "A"), Cells(3, "F"))
For i = LBound(vals, 1) To UBound(vals, 1)
For j = LBound(vals, 2) To UBound(vals, 2)
If .Cells(i, j).Value2 <> vals(i, j) Then
Application.EnableEvents = False
.Cells(i, "G") = Now
Application.EnableEvents = True
vals(i, j) = .Cells(i, j).Value2
End If
Next j
Next i
End With
End If
End Sub
If the number is Light-blue Id like to extract the value with the name (column A is the name) to another sheet.
So far I have a working formula that extracts the numerical value. I'm just having trouble extracting the number and name to another sheet, which is the second formula that I have listed. I'd also like to learn what each line of code does.
Anything is appreciated, thanks for your help
Function GetColorNum(prange As Range) As Double
Dim xOut As Double
Dim i As Long
For i = 1 To 100
If prange.Cells.Font.ColorIndex = 33 Then
xOut = prange.Value
End If
Next
GetColorNum = xOut
End Function
Sub tickerextract()
Dim c As Range
Dim ticker As String
If GetColorNum = True Then
Cells(i, 1).EntireRow.Copy
c.offset(0, 1) = ticker
Next c
End Sub
If I understand correctly, it's simpler than originally written.
Option Explicit
Sub TickerExtract()
Dim rngTicker As Range
Set rngTicker = Worksheets("Tickers").Range("B1:B100") 'change as needed, assumes value in column B
Dim rngCel As Range
For Each rngCel In rngTicker
If rngCel.Font.ColorIndex = 33 Then
'change name as needed and column references
Worksheets("Other").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(1, 2).Value = Array(rngCel.Offset(, -1).Value, rngCel.Value)
End If
Next
End Sub
Try this (arbitrary start column for source range and arbitrary Destination range):
If prange.Cells.Font.ColorIndex=33 Then
Sheets("NAME").Cells(blah, 1).Copy Sheets("NAME2").Cells(moo, rawr)
End If
You would want this within your loop so that each value as it iterates through the cells and copy/pastes if true.
Here's what I need to do:
1) Loop through every cell in a worksheet
2) Make formatting changes (bold, etc) to fields relative to each field based on the value
What I mean is that if a field has a value of "foo", I want to make the field that is (-1, -3) from it bold, etc. I tried to do this with the following script with no luck.
Thanks
Johnny
Pseudo Code to Explain:
For Each Cell in WorkSheet
If Value of Cell is 'Subtotal'
Make the cell 2 cells to the left and 1 cell up from here bold and underlined
End If
End ForEach
The Failed Macro (I don't really know VB at all):
Sub Macro2()
'
'
'
Dim rnArea As Range
Dim rnCell As Range
Set rnArea = Range("J1:J2000")
For Each rnCell In rnArea
With rnCell
If Not IsError(rnCell.Value) Then
Select Case .Value
Case "000 Total"
ActiveCell.Offset(-1, -3).Select
ActiveCell.Font.Underline = XlUnderlineStyle.xlUnderlineStyleSingleAccounting
End Select
End If
End With
Next
End Sub
Option Explicit
Private Sub macro2()
Dim rnArea As Range
Dim rnCell As Range
' you might need to change the range to the cells/column you want to format e. g. "G1:G2000" '
Set rnArea = Range("J1:J2000")
For Each rnCell In rnArea
With rnCell
If isBold(.Offset(1, 3).Value) Then
.Font.Bold = True
End If
If isUnderlined(.Offset(1, 3).Value) Then
'maybe you want this: .Font.Underline = xlUnderlineStyleSingle '
.Font.Underline = xlUnderlineStyleSingleAccounting
End If
End With
Next
End Sub
Private Function isBold(cellValue As Variant) As Boolean
Dim myList() As Variant
Dim listCount As Integer
Dim i As Integer
myList = Array("Totals", "FooTotal", "SpamTotal")
listCount = 3
isBold = False
For i = 0 To listCount - 1
If cellValue = myList(i) Then
isBold = True
Exit Function
End If
Next i
End Function
Private Function isUnderlined(cellValue As Variant) As Boolean
Dim myList() As Variant
Dim listCount As Integer
Dim i As Integer
myList = Array("FooTotal", "SpamTotal")
listCount = 2
isUnderlined = False
For i = 0 To listCount - 1
If cellValue = myList(i) Then
isUnderlined = True
Exit Function
End If
Next i
End Function
I added two functions but it should have also worked with an extensive if / else if / else.
Based on the comments on the solution above, i think this might be helpful
Sub FormatSpecialCells()
Dim SearchRange As Range
Dim CriteriaRange As Range
Set SearchRange = Range("A2:A24")
Set CriteriaRange = Range("C2:C5")
Dim Cell As Range
For Each Cell In SearchRange
TryMatchValue Cell, CriteriaRange
Next
End Sub
Private Sub TryMatchValue(CellToTest As Range, CellsToSearch As Range)
Dim Cell As Range
For Each Cell In CellsToSearch
If Cell.Value = CellToTest.Value Then
Cell.Copy
CellToTest.PasteSpecial xlPasteFormats, xlPasteSpecialOperationNone, False, False
End If
Next
End Sub
This does not fully accomplish your goal. What it does is it searches a specified list of cells, and it matches them against a seperate list of cells. If it matches the values, it takes the FORMAT of the second list of cells and applies it to the cell it matched in the first list of cells. You can modify this by changing the TryMatchValue function so that instead of matching the CellToTest, it pastes the format onto another cell which is 2 across and one up.
This has the advantage that, if you want to add more values and different formats, you only need to go to your excel sheet and add more values. Also you only need to change the format on that value.
An example would be...
Have the cells you are searching in A1:D1000
Have these values in cells E2:E6...
Subtotal (which is bold and underlined)
Total (which is bold, underlined and italic)
Net (which is bold underlined and Red)
etc...
then when it hits Subtotal, it will change the cell to be bold and underlined.
When it hits Total it will change the cell to be bold underlined and italic
etc etc...
hope this helps
Would the conditional formatting functionality in excel give you what you need without having to write a macro?