Cell Interior Color Index Excel VBA - vba

Based on a language table, column A = Language, B = number, C = coloredcell
I would like to know what is the VBA so whenever I type a number on Column B (using Workbook_SheetChange), C is colored with the Colorindex equal to the number typed.
On the other hand, and I am sure is part of the solution to the previous question, on VBA how do I write cell.Interior.ColorIndex = (a specific cell value, If B2=4 -> for the row, whole or until last column has data, cell.Interior.ColorIndex = 4) and color the whole row.
Thank you

The sheetchange function has target as an argument, that's the cell that you changed. You can use it to change the relevant cell:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Target.Offset(0,1).Interior.ColorIndex = Target.Value
'and for the whole row
Target.EntireRow.Interior.Color = Target.Offset(0,1).Interior.Color
Endif
End Sub

The code of Nick Dewitt is OK, but it color only the column C.
If you want to color the entire row, starting from C depending of how much columns are in the row :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastcol As Integer, i As Integer
If Target.Column = 2 Then
lastcol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column
For i = 3 To lastcol
Target.Offset(0, i - 2).Interior.ColorIndex = Target.Value
Next i
End If
End Sub

Right click on the sheet's name on which you want this functionality, and click on 'View Code'.
Now you need to write a VBA function that fires on any change to the worksheet. This is an inbuilt function called Worksheet_Change(Range). The range object (it's argument) is the range that had changed when this function fired.
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Inside the function you need to check whether the changed cell was in column B. This is done by the Column property of the Target range.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
' The changed cell was in column B
End If
End Sub
Now you need to get the cell's value and put it as the row's ColorIndex.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
ColorValue = Target.Value
Target.EntireRow.Interior.ColorIndex = ColorValue
End If
End Sub
Edit: To color the cells only till the last value in the row, you need to count the number of filled cells in the row. The following code does that (see the comments to understand it)
Private Sub Worksheet_Change(ByVal Target As Range)
' Check if the edited cell is in column B
If Target.Column = 2 Then
' Get the value of the edited cell
ColorValue = Target.Value
' Get the row number of the edited cell
RowNumber = Target.Row
' Get the number of filled cells in this row
CellsCount = Application.WorksheetFunction.CountA(Range(RowNumber & ":" & RowNumber))
' Apply the color formatting till the last column in this row
Range(Cells(RowNumber, 1), Cells(RowNumber, CellsCount)).Interior.ColorIndex = ColorValue
End If
End Sub

Related

Worksheet_SelectionChange(ByVal Target As Range), Two Cells in Target

I am using the event handler, and I run certain events if either one cell or two cells are selected. The issue I'm having is, when two cells are selected, I don't know how to access the attributes of that 2nd cell (Ie, what it's value is). Any idea how I can access the value of the 2nd cell thats selected (I was hoping Target would be an array object, and I could just select by array index....)
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo disError
If Target.Cells.Count > 2 Or Target.Address = Range("DataHist").Address Then Exit Sub
Dim curve As String
Dim Ticker As String
Dim TickerTwo As String
Dim lastValue As Double
TickerTwo = ""
If Target.Cells.Count = 1 Then
Ticker = Target.Value
lastValue = Round(Target.Offset(0, 1).Value, 3)
curve = CheckLabel(Target)
Else
' This is where the issue is --------------------------------
Ticker = Target.Cells(1, 1).Value
TickerTwo = Target.Next.Value
lastValue = Round(Target.Offset(0, 1).Value, 3)
curve = CheckLabel(Target)
' -----------------------------------------------------------
End If
Select Case curve
Case "na"
Exit Sub
Case "Test1"
Call FillChart("Test1", Ticker, lastValue, TickerTwo)
Case "Test2"
Call FillChart("Test2", Ticker, lastValue, TickerTwo)
End Select
disError:
End Sub
If you don't know if the User is going to select cells in a column or cells in a row, or even a block of cells, use a loop and counter:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range, i As Long
i = 1
If Target.Count > 1 Then
For Each r In Target
MsgBox r.Address(0, 0) & vbCrLf & i
i = i + 1
Next r
End If
End Sub
Then process when i=2. It will be the cell-to-the-right if a block or row is selected or the cell-below if part of a column is selected.
While this is not pretty code, at least it will work, even if the User selects a disjoint set of cells.
EDIT#1:
You can avoid the ugly loop if you are willing to parse Selection.Address
EDIT#2:
This code (without any loops) will work if the User selects 2 and only 2 cells:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim s As String
If Target.Count = 2 Then
s = Split(Replace(Target.Address(0, 0), ":", ","), ",")(1)
MsgBox "The second cell is: " & s
End If
End Sub

Applying VBA for a particular cell to a selection/column automatically

I am new to VBA and require some assistance. I have found VBA that will look at the value of the active cell and insert a number of rows equal to the value in the cell.
The problem I have is that this only works for the active cell, I have a column for which I would like this process to be automated for. Would anyone know what I should change in the code below?
Sub InsertSome()
Dim i As Integer, n As Integer, m As Long
n = ActiveCell.Value
m = ActiveCell.Row
For i = 1 To n
Rows(m * i + 1).Insert
Next i
End Sub
Thanks in Advance!
You have to use Events. Insert this code in the module of the sheet where you want this working. It will run every time you select a cell in column C.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing And Target.Value <> "" Then '<-Change "C:C" to your column
Dim i As Integer, n As Integer, m As Long
n = Target.Value
m = Target.Row
For i = 1 To n
Rows(m * i + 1).Insert
Next i
End If
End Sub
You can use one of the Worksheet events, such as Worksheet_SelectionChange or Worksheet_Change events.
Also, you don't need to have so many variables, you can use the properties of Target object (equivalent to ActiveCell). Also, you can add multiple rows at once (there's no need to have a For loop).
Code
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' modify column "A" to your desired column
If Not Intersect(Target, Range("A:A")) Is Nothing Then
' make sure the value is numeric, positive, and you select a single cell
If Target.Value > 0 And Trim(Target.Value) <> "" And IsNumeric(Target.Value) And Target.Cells.Count = 1 Then
' no need for a loop to add 1 row at a time,
' just use the line below to add the number of rows in the Target (acitveCell) at once
Range(Cells(Target.Row + 1, 1), Cells(Target.Row + Target.Value, 1)).EntireRow.Insert
End If
End If
End Sub

Excel macro - type mismatch error

im a noob.
My macro adds a date when a cell value changes to "Closed".
Specifically, when a cell value in column M changes to "Closed", it adds the date 2 cells to the left, in column K.
Works perfectly, until i edit more than one cell in either column. If i do that, i get a 13 type mismatch error.
This sucks as it means an error comes up each time i autofill.
Click for image of problem...
thanks in advance.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 13 And Target = "Closed" Then
Target.Offset(0, -2) = Format(Now(), "yyyy-mm-dd")
End If
End Sub
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
For Each cell In Target
If cell.Column = 13 And cell = "Closed" Then
Target.Offset(0, -2) = Format(Now(), "yyyy-mm-dd")
End If
Next cell
End Sub

Excel 2010: I need to offset cell selection ten cells to the right when entering specific text

In the spreadsheet, I want to make it automatically select column P whenever I type the letters FR and press enter into any cell in column F.
What code will do this?
Add the following event routine to the worksheet's code module
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Text = "FR" Then Target.Offset(, 10).Select
End Sub
If you want to select the whole column P not only the cell on the same row,
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Text = "FR" Then Columns("P").Select
End Sub

Change cells to the right for as much as the current cell was changed

I have a train arrival/departure timetable, each branch line is on a separate row. I need to make the spreadsheet automatically detect change in cell and change all cells to the right from it for the same amount of time. Cells have format of time. How do I do that?
What I've tried so far:
I found this piece of code in some other question on SE:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("H5")) Is Nothing Then Macro
End Sub
But I wasn't able to understand where to put it and how to make it work automatically, apart from working for a specific range, which might be different from what was in the question where I found it.
UPD: The logic I'm looking for in VBA:
Wait until a cell is selected, if it has Time format, copy its value to Tmp.
Save the difference between old and new values to Tmp.
If a cell to the right contains something and its format is Time, add Tmp to it.
Continue until cell is empty.
if you know how much difference is between times, then you can calculate the new time based on that difference.
e.g. A1 is 10:07, A2 is 10:14. Instead of having to type in each time individually, you could have A2 as =A1+TIME(0,7,0). Then when you changed A1 to 10:15, A2 would automatically change to 10:22
OK this may get you started in the right direction:
You first want to store all the original cell values. So, the following VBA code stores the values in column A for the first 200 rows into an array. You need to run this code first, perhaps when the workbook is opened:
Dim contents(200) As Variant
Public Sub StoreOriginalValues()
' save all existing values
For r = 1 To 200 ' change for number of rows you have
contents(r) = Worksheets(1).Cells(r, 1).Value
Next
End Sub
Once the original cell values are stored, you can place code in the Worksheet_Change event so that whenever the user changes a cell in column A you can compare the original and new value and figure out the difference. Then you can apply this difference to the rest of the columns in that row:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then ' only check for changes in column A
originalvalue = contents(Target.Row)
newvalue = Target.Value
contents(Target.Row) = Target.Value
difference = newvalue - originalvalue
Set chgcell = Cells(Target.Row, Target.Column + 1)
Do While Not IsEmpty(chgcell)
chgcell.Value = chgcell.Value + difference
Set chgcell = chgcell.Offset(0, 1) ' move one column to right
Loop
End If
End Sub
Now this code is by no means perfect. It does not check that they entered a valid time, for instance. It also does not check to see if the values entered in the rest of the columns in the row are times or text or whatnot. But like I said I hope it will point you in the right direction.
My solution:
Dim oldVal
Dim diff
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
oldVal = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
ActiveCell.Offset(-1, 0).Select
Application.EnableEvents = True
diff = Target.Value - oldVal
If Not diff = 0 Then
While Not ActiveCell.Offset(0, 1) = "#"
Application.EnableEvents = False
ActiveCell.Offset(0, 1).Select
Application.EnableEvents = True
If Not ActiveCell Is Nothing _
And Not ActiveCell = "" _
And TypeName(ActiveCell) = TypeName(ActiveCell.Offset(0, -1)) Then
Application.EnableEvents = False
ActiveCell.Value = ActiveCell.Value + diff
Application.EnableEvents = True
End If
Wend
End If
End Sub
This has been my first experience with VB in a very long time, so the code is terrible, but it works.