When formula result changes in my table in column K range ("K2:K5") I want the entire row in the table to be filled with a color. But I only want the row to be colored if the result is not equal to 0.
So eg. if the result changes in K2 (and is not = 0) the entire row A2:L2 will be colored.
The formula are refering to values that you select from dropdown-lists (created from "data validation" on the excel menu Data-tab). These dropdowns are located on the same row (eg. “D2:J2”) as the related formula. The values in the dropdown is refering to a range on the same sheet outside of the table.
So far I have one code for the worksheet concerning the change event that calls the module with the sub that will change the color on the row.
But it doesn't work and I get no error messages.
This is the code for the worksheet change event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "§D2:§J2" Then
Color_Row
End If
End Sub
Here the target address should propably be the whole range, but I don't know how to give the right syntax for that.
Here is the code for changing color on row:
Sub Color_Row()
Dim r As Long, c As Long 'r=rows in the excel sheet | c= value of cell in _
column k
Dim numrow As Long 'last row with data
Dim tblR As Long 'tablerow
numrow = TimeMeasure.Range("K" & Rows.Count).End(xlUp).Row
For r = 2 To numrow
tblR = r - 1
c = Cells(r, 11).Value
If c <> 0 Then
[TimeDist].Rows(tblR).Interior.Color = 12961279
Else
[TimeDist].Rows(tblR).Interior.Color = xlNone 'no fill color
End If
Next
End Sub
I have steped in to this code and watched variables like c, r, numrow, tblR and it all seems to match my table (the name of my table is TimeDist).
The only thing that I've noticed is that no values ever assigns to c in the loop. I know though that this code works in another workbook, but then I manualy type in a new value in a specific cell outside of the table, which changes the formula result in table (then the rows get colored)
I very thankfuly accept any help on this.
Many thanks for all your inputs which has helped me to solve it! :)
It now works like a charm!
This worksheet_calculate code does the job (I have changed my cell range though):
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("L2:L5")
If Not Intersect(Xrg, Range("L2:L5")) Is Nothing Then
Color_Row
End If
End Sub
Related
I can't figure out the right logic for the VBA to set (hide or show) the columns in some area (columns K to O) based on the "template" area (columns C to G).
In the example below, I hid the column D and I would like to run a code that would scan what columns in range C3 to G3 are hidden or shown and accordingly (show or hide columns) edit the columns in range K3 to O3, which in this example means hiding the column L.
I can work with ranges and can further edit the code for my purposes, but I just don't know how to somehow save the column structure in the template and replicate it in the second area.
Also, there will be formulas in the template and nulls in the edited area, but I think I can do this adjustment on my own.
I will be grateful for any idea.
Hide Columns With Offset
Option Explicit
Sub hideCols()
Const src As String = "C:G"
Const dst As String = "K:O"
Dim n As Long
For n = 1 To Columns(dst).Count
Columns(dst).Columns(n).Hidden = Columns(src).Columns(n).Hidden
Next n
End Sub
Try the next code, please:
Sub testHideUnhide()
Dim sh As Worksheet, rng As Range, cel As Range
Set sh = ActiveSheet 'use here your sheet, if not the active one
Set rng = sh.Range("C3:G3")
For Each cel In rng.cells
cel.Offset(0, 9).EntireColumn.Hidden = cel.EntireColumn.Hidden
Next
It will hide and unhide the columns in rage "K:O" according to "C:G" situation, from this point of view.
Please bear with me as I am self-taught and very new to VBA coding.
I need help with a code for a work project to automatically/dynamically hide a column based on a row value within that column. In my example, based on a Yes/No data validation list in an alternate worksheet, the current worksheet will update and return the same "Yes" or "No" value. If the answer is "No", I need that column to automatically disappear once the user has chosen that option from the Data validation list.
The data set is as follows:
The Yes/No result is on Row 3, in the column range B:AR.
The results of Row 3 are as a result of a transcode formula from another worksheet.
Bonus points if the coding is truly dynamic, in that was I to add rows above Row 3, the code would automatically move to Row 4.
I have scoured the google realms and most code either doesn't update or is strenuously slow. An example of several codes I have attempted are below:
Sub Hide_Columns_Containing_Value()
Dim c As Range
For Each c In Range("B3:AR3").Cells
If c.Value = "No" Then
c.EntireColumn.Hidden = True
End If
Next c
End Sub
Hope a little faster
Sub Hide_Columns_Containing_Value( _
ByVal msg As String, _
ByVal r As Range)
Dim c As Range
Set c = r.Find(msg)
If Not c Is Nothing Then
c.EntireColumn.Hidden = True
End If
End Sub
So this is what you need to Do:
First Define a Named Range in the worksheet for the Rows you want to check No in. Benefit of Named Range is it is Dynamic, so if you add another row before 3rd row, it will dynamically move the Named Range to 4th Row.
Like this:
After Making the named range add this Code to the Worksheet you are on:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("roww")) Is Nothing Then
For Each cel In Range("roww")
If cel.Value = "No" Then Columns(cel.Column).EntireColumn.Hidden = True
Next
End If
End Sub
-Second Code to be added below the First One.
Sub hdd()
For Each cel In Range("roww")
If cel.Value = "No" Then Columns(cel.Column).EntireColumn.Hidden = True
Next
End Sub
Make Sure code is on the Correct sheet to work:
This will be a complete Dynamic code.
I'm trying to create a range in using VBA in Excel 2010 for only the rows which are visible. I've already filtered out the values I don't want and I'm using the keyword xlCelltypeVisible, and yet, when I test it out the range is still showing the fields in that range which should be hidden.
I've tried several different variations of creating a range, and nothing seems to work. It simply appears that the xlCellTypevisible is not working.
This is not the actual worksheet that I am working with, but for demonstration purposes this sums up exactly what my problem is:
Sub create_range()
ActiveSheet.Range("$A$3:$C$8").AutoFilter Field:=3, Criteria1:="North"
Set a = Range("A3", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
MsgBox (a(3))
End Sub
In this situation I have three columns, A3 = "Opt A", B3 = "Opt B", and C3 = "Opt C".
Under field Opt A I have A, B, C, D, E
Under field Opt B I have 1, 2, 3, 4, 5
Under field Opt C I have North, East, West, South, North
As you can see in my code above I have filtered on the value for "North" in the Field for Opt C. As a result in column A I see "Opt A", "A", "E".
My expectation is that when i create a range I can select these options, and only these options. But this is not working. If is select a(1), I correctly see "Opt A" as A3, which is what I expect. But when i select the third, and should be final value in the range with a(3), I see "B" instead of "E".
This issue is caused by the way that Excel treats 2 things: Cells outside of defined Ranges, and Non-Contiguous Ranges
For the first: if I define rng = Range("A1:B2"), and then call MsgBox rng.Cells(3,3).Address, it will give me "C3" - even though that is not part of the range. Excel automatically looks outside of the range
For the second: In your example, MsgBox a.Address would give "A3:A4,A8" - a range with 2 areas (A3:A4 and A8). When you try to reference it without specifying an area, it instead defaults to the first area (A3:A4) - and then, as per out first point, extends the range to find a value.
Here is a rough function to return the nth cell in a non-contiguous column:
Function NthCellInColumn(ByRef Target As Range, ByRef Cell As Long) As Range
Dim DiscardedCells As Long, WhichArea As Long
DiscardedCells = 0
For WhichArea = 1 To Target.Areas.Count
'Is the cell in this area?
If Cell <= DiscardedCells + Target.Areas(WhichArea).Cells.Count Then
'Yes, so let's find it
Set NthCellInColumn = Target.Areas(WhichArea).Cells(Cell - DiscardedCells, 1)
Exit For 'Stop looping through areas
Else
'No, so Discard the Cells
DiscardedCells = DiscardedCells + Target.Areas(WhichArea).Cells.Count
End If
Next WhichArea
End Function
Use it like this: MsgBox NthCellInColumn(a,3).Value
Its best practice to always qualify all your objects in VBA. Otherwise, unexpected results can and will happen.
Try this:
Option Explicit 'always include this at top of your modules; it forces variable declaration and saves you from massive headaches :)
Sub create_range()
Dim mySheet as Worksheet
Set mySheet = Worksheets("Sheet1") 'change as needed
With mySheet
.Range("$A$3:$C$8").AutoFilter Field:=3, Criteria1:="North"
Dim a as Range 'you need to declare as a range, since you are setting it to a range object
Set a = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
MsgBox a.Areas.Item(1).Cells(1,1).Value 'first cell
Dim lastA as Range 'in case the last area is contiguous
Set lastA = a.Areas.Item(a.Areas.Count)
Msgbox lastA.Cells(lastA.Rows.Count,1) 'last cell
End With
End Sub
So I'm working on an excel sheet, and this is something i really can't figure out.
I want it to be that if the contents of a cell match certain criteria, an entire column of cells will be pasted according to that cell. The cell is a drop down with 32 different options (that can be reduced if theres no way to do it) and each option corresponds to a different column of data. The columns that have to be pasted have roughly 32 cells of data each.
My current formula is basically =IFS(A1="Potato",Sheet2!G:G) but this gives me a '0'. The best i can do is change the formula to =IFS(A1="Potato",Sheet2!G1) or =IFS(A1="Potato",Sheet2!G1:G32) but both of these formulas give me the contents of the first cell only (G1).
Any ideas on how I could get this done without having to contact aliens or build a spaceship?
You can use formulas, or VBA.
I have assumed your 32 columns of source data are in Sheet2 with the headers in row 1.
Formula Solution
In Sheet1 A73, enter:
=INDEX(Sheet2!$A$1:$AF$41,ROW(A1),MATCH($A$1,Sheet2!$A$1:$AF$1,0))
Copy this formula to Sheet1 A74:A105
VBA Solution
Put this code in the Sheet1 module;
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
With Sheet2
Set c = .Rows(1).Find(what:=Sheet1.Range("A1").Value)
If Not c Is Nothing Then
Set c = Intersect(.UsedRange, c.EntireColumn)
Sheet1.Range("A73").Resize(c.Rows.Count, 1).Delete
c.Copy Sheet1.Range("A73")
End If
End With
Application.EnableEvents = True
End If
End Sub
EDITED ANSWER: (according to comment)
We have the following layout of products
Private Sub CommandButton1_Click()
'first we check the user input
Dim u_input As String
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
u_input = LCase(Trim(ws.Range("A1").Value2))
'now we need to determine how many columns there are so we know when to stop looping
Dim lc As Long, lr As Long
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' loops through all the products
For Each cell In Range(Cells(1, "F"), Cells(1, lc))
' if the product matches the input
If LCase(Trim(cell)) = u_input Then
lr = ws.Cells(ws.Rows.Count, cell.Column).End(xlUp).Row
' copy and paste the active data range to A37
ws.Range(Cells(1, cell.Column), Cells(lr, cell.Column)).Copy
Sheets("Sheet2").Range("A37").PasteSpecial
End If
Next cell
End Sub
So, upon entering cucumber and clicking the button:
We would get the following result:
You can add any number of products there, as long as the first product starts in column F. (though that can also be changed in code).
PS: This will however end up overwriting your data and also cause data to overlap if your data ranges are not the same. It probably would be smarter to paste the data into the next empty row in sheet2 instead of directly to A37
This can be achieved by changing the line
Sheets("Sheet2").Range("A37").PasteSpecial to Sheets("Sheet2").Range(Cells((Rows.Count, "A").End(xlUp).Row, "A")).PasteSpecial
I have a sheet where employees enter a reservation on each row in Excel. I'm trying to create code that will prevent them from skipping rows.
I have a formula in Col W that determines how many cells were filled out in a particular row (Col C:K) so that the row has at least most the info needed. I have a worksheet change event within that sheet that when the formula reaches 6, the code should unlock the next row of Col C:K, allowing the user to use the next row. My code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim c As Range
Set rng = Range("W6:W504")
For Each c In rng
If c.Value >= 6 Then
Worksheets("January").Unprotect Password:="XXX"
c.Offset(1, -20).Resize(0, 8).Locked = False 'should unlock C7:K7
End If
Next c
End Sub
I've tried to combine the offset and resize lines, enter them on separate lines, select them then apply the unlock, but all to no avail. The closest I've come is to separate the offset and resize, and select the appropriate cell on the next row (C7), but I can't get it to resize then apply the lock. Thanks!