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).
Related
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.
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 would like to swap selected cell ranges within the same column without having automatically adjusted attached formulas in other columns. Those cell ranges will almost always be of unequal size.
I found a VBA code which does it for two selected cells, but im afraid that this wont help me much.
Sub SwapCells()
Dim sHolder As String
If Selection.Cells.Count = 2 Then
With Selection
sHolder = .Cells(1).Formula
If .Areas.Count = 2 Then ' Cells selected using Ctrl key
.Areas(1).Formula = .Areas(2).Formula
.Areas(2).Formula = sHolder
Else ' Adjacent cells are selected
.Cells(1).Formula = .Cells(2).Formula
.Cells(2).Formula = sHolder
End If
End With
Else
MsgBox "Select only TWO cells to swap", vbCritical
End If
End Sub
I know that another option would be to hold 'shift' when moving the cell ranges (works perfectly fine), but then all the attached formulas will change their reference which I dont want (e.g. if I have a formula referring to cell A1, and im swapping A1 somewhere, the formula will refer to A1's new position, but I want the formula to still refer to A1).
I think another option would be to use INDIRECT("G" & ROW()) to fix it, but since its a quite resource-intensive formula, Id love to see an alternative.
On top of that, the latter two options would not allow me to use tables (which Id prefer for other reasons) because you cant swap cells in tables. This is why Id strongly prefer a VBA option.
I hope you can help me, thank you! Maybe it is only necessary to adjust the VBA code a little.
Kind regards,
Marco
EDIT: If it is significantly easier to swap two equal cell ranges (e.g. encompassing 5 cells each), then it would also be a good solution.
Sub SwapTwoSelectedRanges()
Dim initialRng As Range
Set initialRng = Selection
If initialRng.Areas.Count <> 2 Then
Debug.Print "Select 2 areas!"
Exit Sub
End If
If initialRng.Areas(1).Cells.Count <> initialRng.Areas(2).Cells.Count Then
Debug.Print "The cells should be the same number!"
Exit Sub
End If
Dim intermediateRng As Variant
intermediateRng = initialRng.Areas(1).Cells.Value2
initialRng.Areas(1).Cells.Value2 = initialRng.Areas(2).Cells.Value2
initialRng.Areas(2).Cells.Value2 = intermediateRng
End Sub
Swaping two values is considered an easy task, if you are using an intermediate value. With the ranges, there are two important checks to perform, before swapping them:
Are the selected areas exactly 2;
Is the number of cells equal in every area;
Then with an intermediateRng as a 3. variable, the swap is made;
This would only work, if the Areas are per column. If the selection is made per row, then the results would not be as expected;
Concerning the swaping of the colors, if the colors of all the cells per area are exactly the same, this would work:
Dim intermediateRng As Variant
Dim intermediateClr As Variant
intermediateRng = initialRng.Areas(1).Cells.Value2
intermediateClr = initialRng.Areas(1).Cells.Interior.Color
With initialRng
.Areas(1).Cells.Value2 = .Areas(2).Cells.Value2
.Areas(1).Cells.Interior.Color = .Areas(2).Cells.Interior.Color
.Areas(2).Cells.Value2 = intermediateRng
.Areas(2).Cells.Interior.Color = intermediateClr
End With
However, if the colors of the cells per Area are not the same, then the easiest way is to copy+paste the first range to a separate range and work from there.
So I've searched everywhere... I have an office 2007 excel spreadsheet with two pages, one labeled "i" and the other "t." I need to display selective rows (those rows that have a value in column A--not all do) from "i" in "t." I also need the rows in the "t" page to be in numerical order. I figured out how to do it across all rows, but not how to selectively add rows with values only in column A. Further, when I add new rows to "i," "t" doesn't automatically update. Any advice on how to accomplish this would be of immense help!
I have access to office 2010. I don't know if that makes the coding easier?
Thank you!
Jason
You could try a user-defined function like this:
Function NonBlank(Selection As Range, Index As Integer) As Variant
Dim Count As Integer
Count = 0
For Each cell In Selection
If Len(cell.Value) > 0 Then Count = Count + 1
If Index = Count Then
NonBlank = cell.Value
Exit For
End If
Next
End Function
Then on Sheet t, you can put =NonBlank(i!A:A,ROW(A1)) in the first cell where you want the first non-blank value of Sheet i, and then copy the formulas down.
I want to remove rows based on duplicate cells in a column from large sheet, without leaving duplicate sample (like "Remove Duplicates" Excel command does). So if I have:
1
2
2
3
I want, as a result:
1
3
This can be accomplished with conditional formatting, then filtering or sorting duplicates and deleting filtered data, but the process is very slow for large sheet.
Conditional formatting takes second, but just clicking on filter takes around 5min to display filter context menu and additional 20-30min to do actual filtering based on color. I tried this process on a different PCs with 4 cores and plenty of RAM and 100.000 rows sheet
I then thought to write VBA, iterate column cells and if cell is colored, then delete entire row (this is possible in Excel 2010, with Cells().DisplayFormat) but processing takes even more time.
Can someone suggest a faster way to remove duplicates on large sheet?
EDIT: Note that I have used 2 functions. Of this, test is a function to test whether the function works (which you will have to modify per your scenario).
Also, I filled cell A1 to A100000 with test values. Please modify it per your needs.
Option Explicit
Function GetUniqueItems(ByVal src As Range) As Variant
Dim returnValue
Dim dictOfItemsWith1Value
Dim dictOfItemsWithMoreThan1Value
Dim countOfCells As Long
Dim counter As Long
Dim srcValues As Variant
Dim currentValue
Dim cell As Range
srcValues = src.Value
countOfCells = src.Cells.Count
Set dictOfItemsWith1Value = CreateObject("Scripting.Dictionary")
Set dictOfItemsWithMoreThan1Value = CreateObject("Scripting.Dictionary")
For counter = 1 To countOfCells
currentValue = srcValues(counter, 1)
If dictOfItemsWithMoreThan1Value.exists(currentValue) Then
dictOfItemsWithMoreThan1Value(currentValue) = dictOfItemsWithMoreThan1Value(currentValue) + 1
Else
If Not dictOfItemsWith1Value.exists(currentValue) Then
dictOfItemsWith1Value.Add currentValue, 1
Else
dictOfItemsWith1Value.Remove currentValue
dictOfItemsWithMoreThan1Value.Add currentValue, 1
End If
End If
Next
ReDim returnValue(1 To dictOfItemsWith1Value.Count, 1 To 1)
Dim key
counter = 1
For Each key In dictOfItemsWith1Value.keys
returnValue(counter, 1) = key
counter = counter + 1
Next
GetUniqueItems = returnValue
End Function
Sub test()
Debug.Print Now
Dim uniqueValues
uniqueValues = GetUniqueItems(Range("A1:A100000"))
Range("A1:A100000").ClearContents
Range("A1").Resize(UBound(uniqueValues, 1)) = uniqueValues
Debug.Print Now
End Sub
My way to deal with large excel files where I have to remove large chunks of data:
After the last column, use a countif() (much like KazJaw and DanM's countif)
=COUNTIF($A$1:$A$100000,A1)
$A$1:$A$100000 contains your ids. Change accordingly.
Drag the formula to the bottom (Fill Down, or select the range $B$1:$B$100000 if this is the column you put the helper column then Ctrl+D)
Copy column and paste values in place to remove the formula. This will prevent any recalculations during/after any filtering.
Sort by the column with the counts. This makes deleting the large portion of rows much faster later on.
Look for where you start to get counts of 2 and delete all rows till bottom.
Delete the helper column.
Now, if you want to restore the original order, put yet another column after the count, after step 3 above, and after step 5, sort this new column by ascending order before deleting it in step 6.
If you data is in located in column A, this formula should do what you need fairly efficiently:
=COUNTIF(A$1:A$100000,A1)
This formula counts how many times the value in A1 appears in the range A1:A100000. (The dollar signs keep that range from moving down as your drag your formula down.)
Place this in B1 and drag down* to B100000 (assuming you have 100,000 rows).
Then just do a filter on column B to show only 1. (More than 1 means you have duplicates and shouldn't show it.)
*A short cut for dragging down is to just select B1, then press Ctrl-End, then hold down shift and click B100000. Then do Ctrl-D (which is a shortcut for Fill Down).