Inventory Macro / Conditional Formatting - vba

I'm taking on a project in which I've built a map of locations in which house inventory. On one sheet is the map and on another sheet would be inventory that hasnt moved in X number of days pulled from a query. What I'm wanting to do is highlight the location on the map with a red color that corresponds to the location containing old inventory.
Examples of each:
Map_Locations
Old_Inventory_With_Location
I attempted to do this using Conditional formatting but couldnt come up with a formula to accomplish this, I also wrote the following code hoping for the same results with no success (running this causes excel to crash):
Sub Highlight()
Dim Locations As Range
Dim Old_Inv As Range
Dim MyRange As Range
Dim MyRange2 As Range
Set Locations = Worksheets("Sheet3").Range("C4:CD71")
Set Old_Inv = Worksheets("Sheet2").Range("C2:C20000")
For Each MyRange In Locations
For Each MyRange2 In Old_Inv
If MyRange.Value = MyRange2.Value Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
End With
End If
Next MyRange2
Next MyRange
End Sub
Please note I have very little experience using VBA, sorry if this is way off the mark. Any thoughts or suggestions would be much appreciated

For conditional formatting:
Select cell C4 of your location sheet
Open Conditional Formatting,
Manage Rules, New Rule
Select "Use a formula to determine with cells
to format" (last option)
Type the following formula into the box
"format values where this formula is true" (note that you might have
to change the formula if you have different language settings)
=NOT(ISNA(VLOOKUP(C4, Sheet2!$C$2:$C$2000,1,FALSE)))
Click the format button to select the color you want (on the Fill-tab)
Press Ok 2 times and enter =$C$4:$CD$71 in field "Applies to"
Explanation of the formula:
VLOOKUP will search the value of cell C4 (1st parameter) within the given range of Sheet2 (2nd parameter). It returns this value (the 3rd parameter, 1 in the formula tells this) if the exact value is found (the 4th parameter must be FALSE).
If the value is not found, excel returns #NA which is checked by the surrounding IsNA-function. As this would format the cells where the value is not in the list, surround the whole stuff with the NOT- function which will revert the result.

Related

On the selection of a single cell

As in https://www.ozgrid.com/VBA/special-cells.htm the author says:
when/if one specifies only a single cell (via Selection or Range)
Excel will assume you wish to work with the entire Worksheet of cells.
My following code (See the result) does select a single cell and the .SpecialCells(xlConstants) method does operate on the entire sheet marking all the cells with a constant red. My question is, however, why selection.Value = 1000 only works only on the single selected cell ("A1"), instead of the whole worksheet (that is all the cells are filled with 1000), According to the logic applied to the .SpecialCells(xlConstants) method?
Sub stkOvflSep7()
' This sub marks red the cells with a constant
' The first cell is selected
' Some other cells are filled with constant
Dim constantCells As Range
Dim cell As Range
Worksheets("Sheet5").Cells.Clear
activesheet.Cells.Interior.Color = xlNone
Range("c1:d4").Value = 2
Range("a1").Select
ActiveCell.Select
selection.Value = 1000 ' The first cell is selected
' Set constantCells = Range("A1").SpecialCells(xlConstants)
Set constantCells = selection.SpecialCells(xlConstants)
For Each cell In constantCells
If cell.Value > 0 Then
cell.Interior.Color = vbRed ' marks red the cells with a constant
End If
Next cell
End Sub
A cell is a cell (and not the entire worksheet) for every property and method.
The speciality you quoted...
As in https://www.ozgrid.com/VBA/special-cells.htm the author says:
when/if one specifies only a single cell (via Selection or Range) Excel will assume you wish to work with the entire Worksheet of cells.
...is because in Excel you can either select a single cell or a range of cells, but you can't deselect everything. For that reason - and because searching and/or selecting specials-cells within a single cell isn't very useful - excel uses the complete sheet for these two functions (i'm not completely sure if there is another function) when only a single cell is selcted (or referenced as range). If more than one cell is selected/referenced excel uses these cells for searching. This is the same for running searches etc. manually on the sheet.
You're not really doing the same thing as the linked article, since you are assigning to a variable, rather than selecting Range("A1").SpecialCells(xlConstants).
I suspect the usedrange version would work though.

How to highlight a cell based on another cells value VBA?

This question has been asked before but I went about doing it another way. I am trying to highlight a cell if it is greater than the value of another cell.
Here is my code:
Sub Error_Search()
Dim Summary As Worksheet
Dim lr As Long
Set Summary = Worksheets("Summary")
lr = Cells(Rows.Count, 20).End(xlUp).Row
With Summary
For i = lr To 3 Step -1
If Range("L" & i).Value > Range("$Q$2:$R$3").Value Then Range("L" & i).Font.Color = -16776961
Next i
End With
End Sub
Range("$Q$2:$R$3") is a merged cell and it is the cell I want to compare the cell I want to highlight to.
I keep getting a mismatch error.
Any help would be greatly appreciated.
Thanks,
G
As mentioned in the comments, the problem is that a multiple-cells Range doesn't have a single Value, even if the cells are merged: Range.Value yields a 2D variant array whenever more than a single cell is involved. So you can fix the bug by only referring to the top-left cell of the merged range instead.
That said...
You don't need any VBA code to do this; conditional formatting handles it quite neatly.
=$C4>$M$3
Note the $ dollar signs: $M$3 would be your merged cell (only the leftmost cell matters), and $C4 is just the first cell you're defining the conditional format into; leaving the row non-absolute (i.e. no $ on the row number) allows you to apply the format to an entire range of cells by specifying the Applies to range:
Note that the format formula is the same regardless of whether we're looking at $M$3 or $M$3:$N$3 merged cells.
Conditional formats will perform much better than any VBA code you can write.

Excel VBA conditional formatting auto-change

Question:
Is there anything that would cause the Formula1 parameter of the FormatConditions.Add method to change automatically, or to change from what is hard-coded in an Excel-VBA macro?
If so, where is the documentation for this behavior?
Description of Problem:
When applying the FormatConditions.Add method to a range, the formula does not match what is specified in the code.
My macro code assigns a formula to a variable named ConditionalRangeFormula. After running the macro the actual conditional formatting formula does not match ConditionalRangeFormula, and the row in the formula does not match the row that was specified in the code. See the "Details" section below for more info.
Hypothesis:
Note 1:
I've noticed that with a range, Excel will automatically "fit" a conditional formatting formula to match the specifics for each cell in a range. For example, in a worksheet with random numbers between 1 and 10 in column A:
I choose column A.
I add a conditional format to column A, with a formula "=IF(A1=2,1)". The cell font is formatted bold red if this formula is true.
Every cell in column A that contains "2" will be bold red, not just cell A1, even though the formula is just for A1.
Is it possible that in the background Excel is doing some changing of my formula in the code above, in an attempt to "guess" what the formula actually should be?
Note 2:
I don't think this is a result of using too many conditional formats for a range. In Microsoft's Excel developer notes for "FormatConditions.Add Method", there is a remark that "You cannot define more than three conditional formats for a range." However, I've successfully added more than three conditional formats with no changes (see details below). Also, I've tested with all other conditional formatting commented out (inactivated), so that only one conditional format is applied, with no changes.
Details:
I'm using Excel 2007 on a Win7 machine.
My code is a little more complex than the example given in the hypothesis above.
The conditional format function is designed to check if a cell in column "AP" is blank, then apply a red outline.
If I place a breakpoint at the With conditionalRange.FormatConditions _.add(xlExpression, , ConditionalRangeFormula) line, I can confirm ConditionalRangeFormula is correct ("=ISBLANK($AP1)"). However, after running, the conditional formatting formula for every cell in the specified range is "=ISBLANK($AP2)". This does what my code specifies.
Please note the working range (ConditionalRange is the code below) actually starts with row 2 of column AP, since row 1 is a header row. As an interesting note, if I make ConditionalRangeFormula "=ISBLANK($AP2)", the conditional formatting formula for every cell in the specified range is "=ISBLANK($AP3)". Notice how the row in the formula is +1 from what is hard coded, just as in the first situation described in the previous paragraph. Interesting behavior, but I can't find documentation for this.
Also, please note that there are four With...End With statements that apply conditional formatting to that cell, before the conditional formatting that gives problems is applied. Each of those first four statements use formulas that work as expected, so I've simplified those code blocks to make the overall code easier to follow. See "Note 2" under the Hypothesis section above for more details.
Here is the code outline:
'define string to identify workbook
Dim w2 As String
w2 = "myworksheet.xlsx"
'define ws2 as worksheet to work on
Dim ws2 As Worksheet: Set ws2 = Workbooks(w2).Worksheets(1)
'define working range
Dim ws2r As range
Set ws2r = ws2.range("E2", ws2.range("E2").End(xlDown))
'add conditional formatting to the working range
With ws2
'see below for .colDiff function
Set ConditionalRange = ws2r.Offset(0, colDiff("E", "AP"))
'The following 4 With...End With statements assign other
'conditional formats, none of which have problems.
'I've simplified these statements to outline what's being done.
'See the last (5th) With...End With statement for
'the unexpected behavior.
WithConditionalRange.FormatConditions _
.add(xlExpression, , ADifferentFormula1)
.Font.Color = someRGBValue
End With
WithConditionalRange.FormatConditions _
.add(xlExpression, , ADifferentFormula2)
.Font.Color = someRGBValue
End With
WithConditionalRange.FormatConditions _
.add(xlExpression, , ADifferentFormula3)
.Font.Color = someRGBValue
End With
WithConditionalRange.FormatConditions _
.add(xlExpression, , ADifferentFormula4)
.Font.Color = someRGBValue
End With
'This With...End With block has unexpected behavior.
ConditionalRangeFormula = "=ISBLANK($AP1)"
With ConditionalRange.FormatConditions _
.add(xlExpression, , ConditionalRangeFormula)
.Borders.color = RGB(192, 0, 0)
End With
End With 'with ws2
Here's the "colDiff" function called in the procedure above:
Public Function colDiff(col1 As String, col2 As String) As Long
With ActiveSheet
'return the number of columns between col1 and col2
colDiff = Abs(.range(col1 & "1").Column - .range(col2 & "1").Column)
End With
End Function
I tested this functionality by placing a header "Data" in AP1, placing random data from AP2 to AP16, then deleting AP1,5,7,13 to make BLANKS and the following worked correctly:
Public Sub Test()
With Range("E2:AP16").FormatConditions.Add(xlExpression, , "=ISBLANK($AP2)")
.Borders.Color = RGB(192, 0, 0)
End With
End Sub
Does the above single function work correctly for you? If not, I would suspect that perhaps there are merged cells or some other spreadsheet specific issue going on.

Get the cell reference of the value found by Excel INDEX function

The Problem
Assume that the active cell contains a formula based on the INDEX function:
=INDEX(myrange, x,y)
I would like to build a macro that locates the value found value by INDEX and moves the focus there, that is a macro changing the active cell to:
Range("myrange").Cells(x,y)
Doing the job without macros (slow but it works)
Apart from trivially moving the selection to myrange and manually counting x rows y and columns, one can:
Copy and paste the formula in another cell as follows:
=CELL("address", INDEX(myrange, x,y))
(that shows the address of the cell matched by INDEX).
Copy the result of the formula above.
Hit F5, Ctrl-V, Enter (paste the copied address in the GoTo dialog).
You are now located on the very cell found by the INDEX function.
Now the challenge is to automate these steps (or similar ones) with a macro.
Tentative macros (not working)
Tentative 1
WorksheetFunction.CELL("address", ActiveCell.Formula)
It doesn't work since CELL for some reason is not part of the members of WorksheetFunction.
Tentative 2
This method involves parsing the INDEX-formula.
Sub GoToIndex()
Dim form As String, rng As String, row As String, col As String
form = ActiveCell.Formula
form = Split(form, "(")(1)
rng = Split(form, ",")(0)
row = Split(form, ",")(1)
col = Split(Split(form, ",")(2), ")")(0)
Range(rng).Cells(row, CInt(col)).Select
End Sub
This method actually works, but only for a simple case, where the main INDEX-formula has no nested subformulas.
Note
Obviously in a real case myrange, x and ycan be both simple values, such as =INDEX(A1:D10, 1,1), or values returned from complex expressions. Typically x, y are the results of a MATCH function.
EDIT
It was discovered that some solutions do not work when myrange is located on a sheet different from that hosting =INDEX(myrange ...).
They are common practice in financial reporting, where some sheets have the main statements whose entries are recalled from others via an INDEX+MATCH formula.
Unfortunately it is just when the found value is located on a "far" report out of sight that you need more the jump-to-the-cell function.
The task could be done in one line much simpler than any other method:
Sub GoToIndex()
Application.Evaluate(ActiveCell.Formula).Select
End Sub
Application.Evaluate(ActiveCell.Formula) returns a range object from which the CELL function gets properties when called from sheets.
EDIT
For navigating from another sheet you should first activate the target sheet:
Option Explicit
Sub GoToIndex()
Dim r As Range
Set r = Application.Evaluate(ActiveCell.Formula)
r.Worksheet.Activate
r.Select
End Sub
Add error handling for a general case:
Option Explicit
Sub GoToIndex()
Dim r As Range
On Error Resume Next ' errors off
Set r = Application.Evaluate(ActiveCell.Formula) ' will work only if the result is a range
On Error GoTo 0 ' errors on
If Not (r Is Nothing) Then
r.Worksheet.Activate
r.Select
End If
End Sub
There are several approaches to select the cell that a formula refers to...
Assume the active cell contains: =INDEX(myrange,x,y).
From the Worksheet, you could try any of these:
Copy the formula from the formula bar and paste into the name box (to the left of the formula bar)
Define the formula as a name, say A. Then type A into the Goto box or (name box)
Insert hyperlink > Existing File or Web page > Address: #INDEX(myrange,x,y)
Adapt the formula to make it a hyperlink: =HYPERLINK("#INDEX(myrange,x,y)")
Or from the VBA editor, either of these should do the trick:
Application.Goto Activecell.FormulaR1C1
Range(Activecell.Formula).Select
Additional Note:
If the cell contains a formula that refers to relative references such as =INDEX(A:A,ROW(),1) the last of these would need some tweaking. (Also see: Excel Evaluate formula error). To allow for this you could try:
Range(Evaluate("cell(""address""," & Mid(ActiveCell.Formula, 2) & ")")).Select
This problem doesn't seem to occur with R1C1 references used in Application.Goto or:
ThisWorkbook.FollowHyperlink "#" & mid(ActiveCell.FormulaR1C1,2)
You could use the MATCH() worksheet function or the VBA FIND() method.
EDIT#1
As you correctly pointed out, INDEX will return a value that may appear many times within the range, but INDEX will always return a value from some fixed spot, say
=INDEX(A1:K100,3,7)
will always give the value in cell G3 so the address is "builtin" to the formula
If, however, we have something like:
=INDEX(A1:K100,Z100,Z101)
Then we would require a macro to parse the formula and evaluate the arguments.
Both #lori_m and #V.B. gave brilliant solutions in their own way almost in parallel.
Very difficult for me to choose the closing answer, but V.B. even created Dropbox test file, so...
Here I just steal the best from parts from them.
'Move to cell found by Index()
Sub GoToIndex()
On Error GoTo ErrorHandler
Application.Goto ActiveCell.FormulaR1C1 ' will work only if the result is a range
Exit Sub
ErrorHandler:
MsgBox ("Active cell does not evaluate to a range")
End Sub
I associated this "jump" macro with CTRL-j and it works like a charm.
If you use balance sheet like worksheets (where INDEX-formulas, selecting entries from other sheets, are very common), I really suggest you to try it.

Copy the contents and formatting of a cell if a column within the row = today()

I'm currently building a small project planner in Excel that uses the current date to plot coloured blocks under a date column to depict which stage of the project we are currently at for a particular customer (see image below).
Behind each of the coloured blocks is a drop-down menu populated by a list on another sheet. My aim is to search for the current date in cell A1 ( populated using today() ) within all columns that follow the freezed panes (depicted by the black right hand border). When the current date is found, the value of in each of the coloured blocks should be copied into the corresponding cells so that as the project progresses, a line of coloured blocks are entered for each day (with the relevant text from the drop-down depicting the current stage of that block).
Currently I am using the following formula copied into all cells that follow the freeze:
=IF(F$1 = $A$1,$C2,"")
However, when the current date is changed this merely moves the copied blocks across to the relevant column without maintaining the old values from previous days.
I've also attempted this with a VLOOKUP so that I can enter it into a macro and run if from a button but the layout does not allow for a successful VLOOKUP.
The simplest solution I believe would be to have a button that allows the user to save the current state of the column with a header that matches the current date however it has been some time since I have coded in VBA and do not remember how to do this.
Any ideas? Thanks in advance.
Not sure if this is exactly what you're looking for, but here goes...
Sub ColorCode()
Dim ws As Worksheet
Dim rng As Range
Dim cel As Range
Set ws = ThisWorkbook.Sheets("SheetNameHere")
Set rng = ws.Range("F1:I1")***
For Each cel In rng
If cel.Value = ws.Range("A1").Value Then
ws.Range("C2:C8").Copy
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteValues
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteFormats
End If
Next
End Sub
If you add that to a new module, you can assign it to a command button. I haven't had a chance to test it, but it cycles through the dates in the first row to see if they match the date in A1. If they do, it copies over the values and formats from C2:C8(change if you need to) into the rows underneath that date. You may need to change some of the ranges to suit your specific worksheet.
So your requirements seem fairly straightforward to me:
you need the tracker to identify the column with today's date
you need to establish a permanent value for each day as it occurs
you need the color of today's values to be added to the cell, and stay that way even after today's date has passed.
The formula you cite in your question, if copied across all cells, will clearly just provide a value on the column for today's date, and unless you use a circular reference to let it self assess and update its value on today's date, it will not retain information when tomorrow comes.
Your idea for a button would work if you want the user to control the time of update, or you could have code that runs either when the workbook opens or when the worksheet itself is activated (placing it in the appropriate object code under either Private Sub Worksheet_Activate() or Private Sub Workbook_Activate().
I think PermaNoob has a right idea of copying the value of the column and pasting the value (rather than the formlula) into that column, but what is missing is appropriate identification of the column containing today's date and the coloring of those cells (if you don't have some method of coloring them that you did not mention). Something like this might work either attached to a button as you suggest, or to the _Activate event as I suggest. This is untested but should give you an idea of how to approach it:
Sub UpdatePlanner()
'~~>dim variables and set initial values
Dim wb As Workbook
Set wb = Workbooks("NAME or INDEX of YOUR workbook")
Dim ws As Worksheet
Set ws = wb.Worksheets("NAME or INDEX of YOUR sheet")
Dim rngHeader As Range
Set rngHeader = ws.Range("F1", ws.Range("F1").End(xlToRight))
Dim rngDate As Range
Dim rngColumn As Range
Dim rngCell As Range
'~~>loop to find the column with today's date
For Each rngDate In rngHeader
If rngDate.value = ws.Range("A1").value Then
Set rngColumn = ws.Range(rngDate.Address, _
ws.Range(rngDate.Address).Offset(65536, 0).End(xlUp)) 'this assumes
'your column may not have a value in every row
Exit For
End If
Next rngDate
'~~>copy and paste the column values and formats
With rngColumn
.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
'~~>loop to add the color formatting (since I don't see this in your formula)
For Each rngCell In rngColumn
If rngCell.value = ws.Range(Cells(rngCell.Row, 3)).value Then
rngCell.Interior.Color = _
ws.Range(Cells(rngCell.Row, 3)).Interior.Color
End If
Next rngCell
End Sub