I am trying to shade every other group of visiable cells.
Each row of my data contains information on a given Order and there can be multiple rows for each order, e.g. Order 1 many have 3 rows while order 2 may have 1 row, etc. The data is sorted by Order Number so all rows for a given order are contiguous.
I have shaded each group vis a helper column (AS) containing the following formula: =IF(ROW()=2,TRUE,IF(A2=A1,AS1,NOT(AS1)))
which results in every other Order group being either TRUE or False. Then I use conditional formatting to shade every "TRUE" row.
This works until I begin filtering my data and then I can end up with either two shaded or to unshaded groups next to each other.
I think what I'm looking for is a VBA function that will compare a cell with previous VISIBLE cell and will return TRUE or FALSE if the match or not.
Any help will be much appreciated.
you can use this code that shades every other row
Sub ShadeThem()
Dim okShade As Boolean
Dim r As Range
For Each r In Range("A1", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
If okShade Then
r.EntireRow.Interior.Color = vbRed
okShade = False
Else
okShade = True
End If
Next
End Sub
I assumed your filtered data affect column A from row 1 downwards
Did they not, just change "A1" and Cells(Rows.Count, "A") to affect the needed column
In order to have it run at every new filtering, you could:
add a helper cell which counts the number of visible rows
=SUBTOTAL(103;A1:A1000)
this will trigger the Worksheet_Calculate event at every filtering
add the Worksheet_Calculate event hander in the relevant sheet code pane
Private Sub Worksheet_Calculate()
ShadeThem
End Sub
As I said in the comments, there's almost surely a better way to do what you're trying as a whole with your spreadsheet (a table!). However, if you really wanted a VBA custom formula to test if a cell is hidden or not you could use this...
Function isHiddenRow(aRange As Range) As Boolean
isHiddenRow = aRange.EntireRow.Hidden
End Function
There's some possibilities this formula assumes:
Only one cell.
Filtering impact of recalculations.
Related
I have a spreadsheet that brings in a table of data via Power Query.
Every time there is a refresh, the table length may change.
I need columns C and D to alternate highlight colors when the value is not the same as the previous row.
How the table should look each time it is refreshed through Power Query and the VBA code runs.
(1) Attempt with conditional formatting:
(Note: This will work correctly only if a value cannot appear later down that list).
Create a rule (or two rules, to be precise) based on a formula. According to your screenshot, I assume that your data starts at row 3 and you want to look at column C.
There is a rather easy formula that you can use to count the number of unique values of a list. The base formula was "borrowed" from ExcelJet and is =SUMPRODUCT(1/COUNTIF(data,data)). The trick now is that you look to the range from the beginning of the list to the actual row by using the range C$3:C3. If you copy the formula down, the start row remains while the end row is changed. Now simple put a IsOdd resp IsEven around the formula.
So the formula is =ISODD(SUMPRODUCT(1/COUNTIF(C$3:C3,C$3:C3))) for the "green" rows and =ISEVEN(SUMPRODUCT(1/COUNTIF(C$3:C3,C$3:C3))) for the yellow. Apply the rule to the range =$C$3:$C$1048576
However, I don't know if this conditional formatting will "survive" an update of the query.
(2)
Formatting with VBA is simple. The following code formats one column of an table (a table in VBA is the type ListObject. Pass the listobject and the column number as parameter:
Sub ColorRows(table As ListObject, columnNumber As Long)
Dim cell As Range, isOdd As Boolean
For Each cell In table.DataBodyRange.Columns(columnNumber).Cells
With cell
If .Offset(-1, 0) <> .Value Then isOdd = Not isOdd
' On a standard Office color scheme, 10 is kind of green and 8 is a dirty yellow
.Interior.ThemeColor = IIf(isOdd, 10, 8)
.Interior.TintAndShade = 0.8
End With
Next
End Sub
This is how the call could look like (adapt the sheet and the listObject to your needs):
Sub test()
ColorRows ThisWorkbook.Sheets(1).ListObjects(1), 3
End Sub
Now calling this code automatically is a different story and unfortunately rather complicated - if you want/need, try https://stackoverflow.com/search?q=vba+QueryTable+After+Refresh for some insights. An easy alternative is to trigger the formatting manually, eg by placing a button (or a shape) on your sheet that calls the code.
The VBA to apply the format condition for the alternating coloring would be:
Public Sub alternatingColorSizeAndKind(rg As Range)
Dim fc As FormatCondition
With rg.FormatConditions
.Delete
Set fc = .Add(xlExpression, , "=($C1=$C2)+($C2=$C3)")
fc.Interior.Color = 14348258
Set fc = .Add(xlExpression, , "=($C1<>$C2)")
fc.Interior.Color = 13431551
End With
End Sub
You have to pass the range of your table to this sub.
If you have a listobject/table then you call it like this:
Public Sub update()
Dim lo As ListObject
'>>> adjust the names to your needs
Set lo = ThisWorkbook.Worksheets("Sheet1").ListObjects("Pull_Data")
alternatingColorSizeAndKind lo.DataBodyRange
End Sub
I am setting up a receipt printout from Excel 2010. I have multiple items on the worksheet and can print everything ok.
The receipt is to be printed in a busy environment and as such we just want the operators to enter the numbers and press CTRL+P.
Not all the items on the receipt will be used:
Item 1 10:00
Item 2 0.00 <--- This is an example of the row I do not want to print
Item 3 10.00
Total 20.00
The number of items could increase over time so the solution must be able to include the entire print range. Use of the hide function is not an option as it takes to long.
The solution must require no action by the user as they are not 'computer people'.
All cells are locked except those which require data to be entered to minimise input errors. i.e. VAT calculations
I had tried a VB routine but with no luck, hence the question.
EDIT: The VB I had written was-
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim RngCol As Range
Dim i As Range
Set RngCol = Range("B1", Range("B" & Rows.Count). _
End(xlUp).Address)
For Each i In RngCol
If i.Value = 0 Then
i.EntireRow.Hidden = True
End If
Next i End Sub
I have tried Jeeped's suggestion but some how the page size has now changed - won't change back either?
Although Jeeped's suggestion has done what I wanted it is now ignoring the header which is needed although I can move the info to the main sheet.
Use a conditional format rule. I always use rules based on formulas like =NOT($D1) to cover columns A:E depending on the value in column D but any of the others will do if you can determine criteria that equals zero. When you decide on how you want to handle the criteria, click Format and go to the Number tab. Choose Custom from the list down teh left and use ;;; (three semi-colons) for the Type:.
Click OK to accept the format and then OK to create the rule. Nothing in A:E will be visible if there is a blank or 0 in column D.
Alternate AutoFilter Method:
The individual worksheets do not have any standard events to do with printing but the workbook has a BeforePrint Event.
Go the workbook's VBE and locate ThisWorkbook in the Project Explorer then double-click it. Paste the following into the new pane on the right titled something like ThisWorkbook (Code).
Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = False
With Worksheets("Sheet2")
If .AutoFilterMode Then .AutoFilterMode = False
With .Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp))
.AutoFilter Field:=1, VisibleDropDown:=False, _
Criteria1:="<>0.00", Operator:=xlAnd, Criteria2:="<>"
End With
End With
End Sub
Edit to suit the actual column that holds the numbers. I've used column B. Note that the AutoFilter requires a header row.
Tap Alt+Q to return to your worksheet. Any method of printing the page will result in the AutoFilter Method being applied to column B and hiding any blanks or zeroes (in the form of 0.00) in that column.
Before:
After:
As you can see from the sample images, printing to a .PDF filters the code column. I've also chosen not to display the little drop-down arrow normally associated with an AutoFilter.
You can unhide the rows with conventional unhide commands, clear the filter or just turn the autofilter off to get the rows back.
This latter method is a bit more involved but it gets rid of (aka hides or filters out) the undesired rows rather than simply not displaying the text in them. If need be, the worksheet could be unprotected for the duration of the print cycle.
How do you count the number of visible columns (ignoring hidden columns) in Excel as function within a certain cell range?
Here's a VBA function for you (since you DID ask for a function, even though you didn't mention VBA as a tag).
Function outCountVisibleColumns(rRange As Range) As Double
outCountVisibleColumns = 0
For Each Col In rRange.Columns
If Col.EntireColumn.Hidden = False Then
outCountVisibleColumns = outCountVisibleColumns + 1
End If
Next Col
End Function
Assuming you put this in your Excel personal workbook, you should be able to put it into cells in any of your spreadsheets like this:
=PERSONAL.XLSB!outCountVisibleColumns(C1:J6)
A fudge is to have a row in your range of nothing but 1s, select it with Go To Special, Visible cells only and read off the count from the status bar (assuming you have that set to show Sum).
All, I need to write a macro that does the following:
On entry data into the last blank cell in column E, sort the entire worksheet by column E in descending order
Once the worksheet is sorted:
2a. Copy the cell to the adjacent cell immediately to the left of the cell into which the data was first entered
2b. Paste the copied data into the first column of the same row from which the data was originally entered
2c. Move the cursor to the adjacent cell immediately to the right of the cell into which the data was first entered
Below, I show the sort on entry code, which works. However, I cannot then get the code to copy, paste, and move correct. My most common problem: after data entry, the rows move, but the cursor stays in the row where the data was first entered. Can anyone help? (I can't even get the indenting right on this post!)
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) Is Nothing) Then
DoSort
End If
End Sub
Private Sub DoSort()
Worksheets("Sheet1").Range("A:E").Sort Key1:=Worksheets("Sheet1").Range("E1"), Order1:=xlDescending, Header:=xlYes
End Sub
Regarding 1, 2a, and 2b: It's more straightforward to do the copying before sorting. That way, the copied value will be sorted along with the rest.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) _
Is Nothing) Then
' First copy
Target.Offset(0, -1).Copy Destination:=Target.Offset(0, -4)
' Then sort
DoSort
End If
End Sub
This leaves the question (2c) of how to move the active cell to the appropriate row after the rows have been sorted. Presumably, you want the user to input further data in column F?
Again, the most straightforward solution would be to have this input happen first, and then do the sorting. This would have the added benefit that the user wouldn't have the input row jump around between inputting data in column E and column F. The sorting could even happen just once, after all the data has been entered by the user.
Of course, the above is more a design suggestion than a solution to your specific task 2c. If moving the active cell after sorting is really what you want, then the solution will inevitably be more complicated. Excel's Sort method does not return an index, to locate your entries after sorting. You will have to make an index / "serial number" yourself and search for it after sorting. This works:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newIndex As Long
If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) _
Is Nothing) Then
' Index the new entry in column B. (You can put the index elsewhere.)
newIndex = WorksheetFunction.Max(Range("B:B")) + 1
Target.Offset(0, -3).Value = newIndex
' Copy the entry.
Target.Offset(0, -1).Copy Destination:=Target.Offset(0, -4)
' Sort
DoSort
' Search for the new index after sorting. Select cell in column 6 (F).
Cells(WorksheetFunction.Match(newIndex, Range("B:B"), 0), 6).Select
End If
End Sub
Making an index is not strictly necessary if all your entries are unique (i.e. no duplicates); you could in principle just search for the entry itself. However, if there can be duplicates, then searching for the entry itself (rather than its index) will be more messy, and may lead to unwanted behaviour unless it's programmed just right. I find it much cleaner to just use an index.
I'd suggest you to save the value that has been entered and search for this value after the sorting.
Notice we may have dup data added into E column, so we'll need to store the other column's information as well until have a reliable key.
So, once you know the value(s) you need to search, find the cell containing the data you added in the column E (that might be in any other row by now, not only in the last one) and use it as an anchor to your other operations.
There are several ways to find a specific entry in a matrix (using Excel or pure VBA, as you wish). If you have problems implementing them, let us know.
Having the cell address (in column E) that contains the value that has just been added, you'll use offset functions to set adjacent values. Again, if you have problems implementing it, let us know your doubt.
Hope it helps :)
Rgds
I need Help!
I am not well versed in VBA or Macros but i cannot find any other way to accomplish what i need to do without using it.
I have a sheet which i will be using to track Purchase orders, and what i need to do is; when i have a row in sheet 1 (Purchase Orders) which has been recieved i.e. the date of receipt has been recorded in column H i need for the entire row to be cut and pasted into sheet 2 (Received orders).
The header takes up the first 7 rows the rows, so i need the macro to look at rows 8-54. Once the received items are removed from sheet 1, i need the row to also be deleted or preferably for the list to be sorted by column A moving the now empty row which has been cut from open for a future entry.
Any help would be greatly appreciated.
The "Record Macro" feature should be enough to do the task you describe.. In Excel 2007, go to the Developer tab in the Ribbon, and select "Record Macro", and perform exactly the steps you are describing. It will record the equivalent VBA code, which you can then execute - or tweak/modify.
I tested this out, here's one way to do it:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim receivedDate As Range, nextOpen As Range, isect As Range
Set receivedDate = Sheet1.Range("H8:H54")
Set isect = Application.Intersect(Target, receivedDate)
If Not (isect Is Nothing) And IsDate(Target) = True Then
Set nextOpen = Sheet2.Range("A1").End(xlDown).Offset(1, 0)
Target.EntireRow.Copy Destination:=nextOpen.EntireRow
Target.EntireRow.Delete
End If
Application.EnableEvents = True
End Sub
This would be pasted into the Sheet1 code. Any time a cell is changed on sheet1, the code checks to see if it's in the critical range that you specified. (H8:H54) If it is, it then checks to see if it's a date. If it is, it then copies the entire row, puts it in the next open row on Sheet2, and deletes the original row. The cells below it will get shifted up so there are no gaps.
Since the code functions on a cell changing event, it disables "Application.EnableEvents" in order to avoid a loop of changing a cell to call an event which changes a cell to call an event... etc.