Basically, I want to make a code that selects the Excel's cells according to the content.
I found to hard to explain in words, so I uploaded this image.
I want to select with a red border all the lines that contains the check mark. But if one line with the check mark is followed by another with the check mark, just do a big selection. (like I did manually in the image)
Any solution?
Thanks in advance
I know I said otherwise in the comments, but now that I've thought about it some more, this is entirely achievable with conditional formatting.
The idea is you'll set all the borders beforehand and then use conditional formatting to remove the borders that you don't want.
First, set the borders for each row how you want them to appear when there is no checkmark.
When the "Pass" column is "No", you want to remove the left and right border. Set up a conditional format using a formula rule to achieve this. Make sure to lock column D because the formula is being applied to multiple columns and you always want to look at column D.
If the current row has "Yes" in the pass column and the row below it also has "Yes", you want to remove the bottom border. You can use an additional conditional format to do this.
You'll need to cover a few more cases with additional conditional formulas, but this is the general idea.
My approach would be this: First write a sub that puts a red border around the outside of any range. It should look something like this:
Sub ApplyBorder(inputRg as Range)
Call inputRg.BorderAround(Weight:=xlMedium, Color:=vbRed)
End Sub
Now we can iterate through our range. If we find a check, include it in the range to be given a border. If we find an x, then apply the red border around the range we have, and reset it to nothing.
Sub FormatTable()
Dim AllTable As Range, oneRedRg As Range, oneRow As Range
Dim iRow As Integer
Set AllTable = GetTable
For iRow = 1 To AllTable.Rows.Count
Set oneRow = AllTable.Rows(iRow)
If oneRow.Cells(1, 3) = True Then
If oneRedRg Is Nothing Then 'if our current redRg is unset,
Set oneRedRg = oneRow 'then this is the first one, so set it
Else
Set oneRedRg = Range(oneRedRg, oneRow) 'if it is already set, then expand oneRedRg to include this one
End If
Else
if Not oneRedRg Is Nothing Then Call ApplyBorder(oneRedRg) 'if we find a range that need not be red, then
Set oneRedRg = Nothing 'apply the border to our redRg and reset it to nothing
End If
Next iRow
If Not oneRedRg Is Nothing Then Call ApplyBorder(oneRedRg) 'this last line captures a group of reds
'that are at the end of the table.
End Sub
I have excluded the "GetTable" function. In my answer, GetTable returns the entire table to be iterated through, without the headers. Also note that I changed the checks and x's to be values "True" or "False" in the spreadsheet for ease.
Happy Coding!
CF with these four rules may serve, where what is not visible is the code point for the ticks (maybe '252'):
and the ranges adjusted, if necessary, to suit.
Related
Reference Image
The Aim: The image shows the “key” on the left, where cells will be coloured manually using mouse input.
A (red background)
B (green background)
C (blue background)
On the right, you see the "data" where content-matching cells should be formatted to match their key (as I've already done for representation purpose in the image)
Initial Situation: No cells are coloured or formatted in any way. The Excel spreadsheet has column A with certain values, And rest of the columns (C onwards) have the same/different values in a random manner (some cells even empty). Not all values in "key" area will be found in "Data" area or vice versa. No new data is being added in any area. User will only colour certain Values in "Key" area as per their wish.
Thus all “C” cells in the Data area should be coloured blue when "C" in Key area is coloured blue. Furthermore, if I change the formatting of “C” in the Key to have a purple background, all the “C” cells should switch from blue to purple. Also, if I add more to the Key (say, “D” with a yellow background) then any “D” cells should become yellow; if I remove a Key entry, then matching values in the Data area should revert to default styling.
I'm open to different trigger techniques,like manually running a macros via shortcut etc.
I suspect that if any of this is possible it will require VBA, but I’ve never used it so I’ve no idea where to start if that’s the case. The closest answer to my question was found here but doesn't entirely work for me:
First I though of using the Worksheet.Change event, by putting something like this into the worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim area As Range, c As Range
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
Set area = Range("B1:F20")
For Each c In area
If c.Value = Target.Value Then c.Interior.Color = Target.Interior.Color
Next c
End If
End Sub
This is just a non-dynamic rough draft, but it "kind of" works.
Problem is that a change of color doesn't trigger the change event, funnily enough, changing the letter to the same letter – so no change at all – does trigger the event, as illustrated below:
We could use the Worksheet_SelectionChange event instead, but then it wouldn't update until next time we selected the cell we want to update.
We could instead force it to update on next selection. Which isn't optimal either:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim reference As Range, refCell As Range, area As Range, areaCell As Range
Set reference = Range("A1:A3") 'Reference range
Set area = Range("B1:F20") 'Search range
For Each refCell In reference 'Loop through the references
For Each areaCell In area 'Loop through search range for each reference
If areaCell.Value = refCell.Value Then areaCell.Interior.Color = refCell.Interior.Color
Next areaCell
Next refCell
End Sub
Obviously, using a button or similar to run the same code would also work, but I'm not entirely sure if we can make it run instantly.
To run it manually, put it as a normal sub in a module. (It still works in the sheet though).
Sub fillColor()
Dim reference As Range, area As Range, areaCell As Range
Application.ScreenUpdating = False
Set reference = Range("A1")
Set area = Range("B1:E25")
For Each areaCell In area
If areaCell.Value = reference.Value Then
areaCell.Interior.Color = reference.Interior.Color
areaCell.Interior.Pattern = reference.Interior.Pattern
End If
Next areaCell
Application.ScreenUpdating = True
End Sub
Still, you might want to add an option on what to to update, so it doesn't update it all.
For my worksheet I have written a VBA code to hide some chosen columns. After hiding these columns I want to mark and color a row. After that I want to unhide the columns so that I get back to my original sheet but with the chosen row fully colored.
The VBA works totally fine. My problem is that when I chose a row (clicking on the number of the row) and color it, when I unhide the columns those cells of the row that were hidden in the columns are not colored.
Is there any chance to color the whole row even though some cells are hidden by the macro?
Thanks
Must say I was unable to recreate the problem. Using code like:
Rows(1).Interior.Color = vbBlue
Does color all cells in a row, even hidden ones. But however, in your case maybe use a piece of code to loop through all cells in a row up to the last used column and color each piece individually. Hopefully that will resolve your issue:
Sub SpecialLoop()
Dim cl As Range, rng As Range
Dim rw As Long
rw = 5 'Obviously just type any row here or get the rownr. some other way
Set rng = ActiveSheet.Range(Cells(rw, 1), Cells(rw, ActiveSheet.Cells(rw, Columns.Count).End(xlToLeft).Column))
For Each cl In rng
If Intersect(cl, rng.SpecialCells(xlCellTypeVisible)) Is Nothing Then
Range(cl.Address).Interior.Color = vbBlue
Else
Range(cl.Address).Interior.Color = vbBlue
End if
Next cl
End Sub
Either way, I hope you can fix it now :)
Thanks. I solved the problem by simply adding the following code line and chose the cells that I wanted to color:
ActiveSheet.Range("A1:A1").Interior.ColorIndex = 1
Color can of course be modified.
Once conditional formatting is applied to a pivot table, if you expand the table, how can the conditional formatting be updated automatically to apply itself to the new expanded pivot table?
Attached is the sample excel file.
The following is verbatim from my post at http://yoursumbuddy.com/re-apply-excel-pivot-table-conditional-formatting/. You might also be interested in http://yoursumbuddy.com/unified-method-of-pivot-table-formatting/:
The key to this code is the ModifyAppliesToRange method of each FormatCondtion. This code identifies the first cell of the row label range and loops through each format condition in that cell and re-applies it to the range formed by the intersection of the row label range and the values range, i.e., the banded area in the first image above.
This method relies on all the conditional formatting you want to re-apply being in that first row labels cell. In cases where the conditional formatting might not apply to the leftmost row label, I’ve still applied it to that column, but modified the condition to check which column it’s in.
This function can be modified and called from a SheetPivotTableUpdate event, so when users or code updates a pivot table it re-applies automatically.
Sub Extend_Pivot_CF_To_Data_Area()
Dim pvtTable As Excel.PivotTable
Dim rngTarget As Excel.Range
Dim rngSource As Excel.Range
Dim i As Long
'check for inapplicable situations
If ActiveSheet Is Nothing Then
MsgBox ("No active worksheet.")
Exit Sub
End If
On Error Resume Next
Set pvtTable = ActiveSheet.PivotTables(ActiveCell.PivotTable.Name)
If Err.Number = 1004 Then
MsgBox "The cursor needs to be in a pivot table"
Exit Sub
End If
On Error GoTo 0
With pvtTable
'format conditions will be applied to row headers and values areas
Set rngTarget = Intersect(.DataBodyRange.EntireRow, .TableRange1)
'set the format condition's source to the first cell in the row area
Set rngSource = rngTarget.Cells(1)
With rngSource.FormatConditions
For i = 1 To .Count
'reset each format condition's range to row header and values areas
.Item(i).ModifyAppliesToRange rngTarget
Next i
End With
'display isn't always refreshed otherwise
Application.ScreenUpdating = True
End With
End Sub
Pivot tables are notoriously unresponsive to formatting and have a history of not keeping manually applied formatting, not even mentioning extending conditional formatting. If you require that,you may want to consider using VBA to re-apply formats after a refresh, or apply conditional formats to whole rows or whole columns.
I'm using 2010 so i can't say this would work in other versions,
also as far as i have tested this only works if you want the conditional formatting to apply to all cells within the pivot chart (not just one specific row of data, you may be able to exclude grand totals, but i haven't tried).
However before doing any coding it might be worth a quick try if you want the formatting to apply to all rows in your table.
Create a New Worksheet > Enter your conditional formatting into a cell in this new worksheet > use the copy formatting paint brush on this cell > go back to your pivot chart worksheet and drag the formatting over first top left hand value down to the last bottom left value.
Refresh your chart, expand collapse your chart, your formatting should stay put, not only that, but even when you remove all the fields from your pivot and add them back in, stays in place. it seems that by doing this it applies the formatting to the chart it'self rather than the individual cells within in.
I found this out quite by accident but as I am often on here looking for answers it seemed only right to let people know what i discovered, even if it was a fluke.
I have two named ranges that overlap one another. While I'm looping down the rows of Range1 (A3:Z20), I need to also loop across the columns of a smaller portion of Range1, so I created Range2 (G1:K20).
What I'm looking for in looping through Range2 is if there is an "X" in any of the columns of the current row of Range1, I need to get the column's heading, which is why Range1 ignores rows 1 and 2, but Range2 does not.
My code sort of looks like this:
For intRowCntr = 1 To Range("Range1").Rows.Count
For intColCntr = 1 To Range("Range2").Columns.Count
If Range("Range1").Cells(intRowCntr, %intColCntr%) = "X" Then
'Do a bunch of stuff here.
End If
Next intColCntr
Next intRowCntr
I marked the %intColCntr% with % to point out where I need the magic to happen. Obviously the %intColCntr% won't work the way it is because it'll be column 1 in Range2 but column 7 in Range1.
This is as simple as I can think to make an example and hopefully someone can see what I'm getting at. Basically I need to know where I am in relation to Range1, while looping through Range2. An acceptable alternative is knowing where I am on the Worksheet itself in both Range1 and Range2, and then working out the details on the worksheet level, before returning to the range loops.
Any advice would be appreciated!
:EDIT:
So I guess I didn't explain well enough, or maybe what I'm doing is overly complicated for what my goal is, so here's more of the story:
I'm trying to populate several listboxes of options that apply to a product.
So imagine Range1 is a list of cars, and Range2, Range3, Range4... are all groups of options that COULD apply to every car in Range1. So Range2 would be colors, Black, White, Red, Yellow, etc... Range3 might be Trim options. Range4 might be body styles, and so on.
Now, I need the user to pick a car (Dodge Dart on Row 5). Now I need to go through Range2 looking for an "X" that denotes which color choices are available to a Dodge Dart. If I find an "X", I need to then grab that column's heading and drop it into a "Colors" listbox control.
I obviously can't just hit every column in Range1 looking for an "X" as every option group has it's own Listbox.
With a bigger picture of what I'm trying to do, is there some way of using Intersect that would make more sense?
Column would work, but I think it would require me to keep track of another set of variables that apply to locations on the Worksheet rather than just the two ranges. It would work but it would be fairly clumsy I think.
Like Doug, I'm not entirely sure what you want to do:
And like Doug, I'm looking on Intersect Function.
So try this:
Dim cel As Range
For Each cel in Range("Range1")
If Not Intersect(cel, Range("Range2")) Is Nothing Then
If cel.value = "X" Then
'do your stuff here
End If
End If
Next
I used For Each Lopp rather than your conventional For-Next Loop so I can easily use the Intersect.
Hope this helps you a bit or maybe solve your problem.
Version2 of above:
Dim cel As Range
For Each cel in Intersect(Range("Range1"),Range("Range2"))
If cel.value = "X" Then
'do your stuff here
End If
Next
I decided to go with just using the Column property. It was far too tedious with the Intersect.
Here's a code snippit of how I made this work:
'...Lots of code looking at the first 4 Array elements...
intHoldCol = Range("Range2").Cells(1, 1).Column
For intColCntr = intHoldCol To intHoldCol + Range("Range2").Columns.Count
If Len(Range("Range1").Cells(intRowCntr, intColCntr)) > 0 _
And Cells(1, intColCntr).Value = arySelected(4) Then
bolTest = True
End If
Next intColCntr
'...Lots more code...
Thank you for your help.
I have a worksheet with cells that may contain text that sometimes exceeds the width and height of the cell. If I don't notice it and adjust the row height, the text shows up as cutoff. Does anyone have a VBA snippet or tool that can locate these cells so I can adjust them? Thanks!
Identifying which column is too wide would be tricky, especially since the text within the cell can have different fonts and/or font sizes. It is much easier to automatically size the columns by making use of the Range.AutoFit method.
As an example, you can call the AutoFit method as follows:
Dim myRange As Excel.Range
Set myRange = Application.Range("A1:C3")
myRange.Columns.AutoFit
The Range.AutoFit method can be a bit too aggressive, however, resulting in columns that are too narrow. Therefore, you might want to create a method that establishes a minimum column width:
Sub AutoFitColumns(theRange As Excel.Range, minColumnWidth As Double)
theRange.Columns.AutoFit
Dim column As Excel.Range
For Each column In theRange.Columns
If column.ColumnWidth < minColumnWidth Then
column.ColumnWidth = minColumnWidth
End If
Next column
End Sub
The above could be called as follows, to autofit the columns, but with a minimum width of 8.5:
Dim myRange As Excel.Range
Set myRange = Application.Range("A1:C3")
Call AutoFitColumns(myRange, 8.5)
You can also autofit the Rows of the Range. This is needed less often, but to do so you'd use something like:
myRange.Rows.AutoFit
Hope this helps!
Update: Reply to Craig's Comment:
Thansk Mike. This spreadsheet is used
as sturctured input to a web interface
generator so the column widths vary
and shouldn't be adjusted. I'm really
just looking for something to scan a
sheet for any cells where the text
displayed is wider than what the cell
will allow to fit, thereby needing the
row height sized larger. I'm not
looking for a process to make the
adjustment, just find them since they
are easy to overlook. Any ideas on
that?
Well, clearly you want to do two things: (1) identify which cells are being cut off, and then (2) correct these cutoffs.
I do understand your desire to do this in two distinct stages, but step (1) is almost impossible to do correctly across all circumstances with Excel because not only can row heights and column widths vary, but text wrapping can be on or off, and the font can be a non-proportional font in any number of potential styles and/or sizes.
In short, there will be no way to reliably identify which cells are being cut off, not without an incredible amount of work. It could be mitigated, however, if you restrict the spreadsheet to only one font style and use a non-proportional font. If you do this, then you could simply compare the column width to the length of the text within the cell. This is because the Excel.Range.ColumnWidth property returns its width calibrated so that one unit of column width is equal to the width of one character in the Normal style. For proportional fonts, the width of the character 0 (zero) is used.
Therefore, for simple cases, where word wrap is not employed and the font is in the Normal style, and, ideally, the Normal font is a non-proportional font, then you could loop through all cells in the range looking for where the value held is longer than the column width:
Dim myRange As Range
Set myRange = Application.Range("A1:E5")
Dim cell As Excel.Range
For Each cell in myRange.Cells
If Len(CStr(cell.Value)) > cell.ColumnWidth Then
MsgBox "The cell at " & cell.Address & " has text that is too long!"
End if
Next cell
But now here comes the next part... How will you correct this? If, again, you have a very simple situation where word wrap is not employed and the font is in the Normal style, and, ideally, the Normal font is a non-proportional font, then you have a few options:
(1) Set the column width to match the cell's value length:
Dim myRange As Range
Set myRange = Application.Range("A1:E5")
Dim cell As Excel.Range
For Each cell in myRange.Cells
If Len(CStr(cell.Value)) > cell.ColumnWidth Then
cell.ColumnWidth = Len(CStr(cell.Value))
End if
Next cell
(2) Auto-fit the Column:
Dim myRange As Range
Set myRange = Application.Range("A1:E5")
Dim cell As Excel.Range
For Each cell in myRange.Cells
If Len(CStr(cell.Value)) > cell.ColumnWidth Then
cell.Columns.AutoFit
End if
Next cell
But if we are going to auto-fit the column, then it is much easier to just call it directly, without checking the column widths first, because not only will the widths be corrected for all cells at one time, but the Range.AutoFit method can handle any font, including non-proportional fonts, in any style.
Therefore, going directly to the auto-fit approach, we have two options: either autofit the columns, or autofit the rows. Based on your most recent quote, it sounds like you want to re-size the rows:
I'm really
just looking for something to scan a
sheet for any cells where the text
displayed is wider than what the cell
will allow to fit, thereby needing the
row height sized larger.
For this I would employ text-wrapping and then autofit the rows. For example,
Dim rng As Excel.Range
Set rng = Application.Range("A1:E5")
With rng.Rows
.WrapText = True
.AutoFit
End With
I think that these are about all your options. In the end, what you want to do and what Excel is capable of doing might not match exactly, but I think you should be able to get done what you need to? Let us know if it does the trick...
-- Mike