I have a data table that filters a column, "Product", based on the user's autofilter selections. I also have "Product" defined as a dynamically named range, which we'll define as A2:A30 for this example. Afterward, I would like to further manipulate the visible cells. A snippet of my debugging code:
Dim xName As Range
Set xName = ThisWorkbook.Names("Product").RefersToRange.SpecialCells(xlCellTypeVisible)
Debug.Print xName.Count
Debug.Print xName(3)
xName.Count would always return the correct number of visible cells, but accessing the index of xName proves troublesome when dealing with non-contiguous hidden cells. For instance, if A2:A5 and A8:A11 are the hidden cells, xName(1) would return A6's value, but xName(3) would return A8's value instead of A12's value. This makes it near impossible for me to loop through just the visible cells.
Is there an index manipulation I can do to only work with visible cells? Any help would be appreciated!
For non-contiguous ranges you can loop using For Each.
E.g.
Sub Tester()
Dim rng As Range, rw As Range
'create a non-contiguous test range
Set rng = Range("A3:D4,A7:D7,A10:D16")
'loop over each row in the range
For Each rw In rng.Rows
Debug.Print rw.Address()
Next rw
End Sub
My suggestion:
Sub test()
Dim xName As Range
Set xName = ThisWorkbook.Names("Product").RefersToRange.SpecialCells(xlCellTypeVisible)
Debug.Print xName.Count
Debug.Print VisibleCell(xName, 3)
End Sub
Function VisibleCell(rng As Range, index As Long) As Range
Dim i As Long
Dim r As Long
i = 0
r = 1
Do
Do While rng(r).EntireRow.RowHeight = 0 Or rng(r).EntireColumn.ColumnWidth = 0
r = r + 1
Loop
i = i + 1
If i = index Then
Set VisibleCell = rng(r)
Exit Do
End If
r = r + 1
Loop
End Function
Maybe this is what you want to do: iterate over the areas of the range because it has been split into many areas due to the hidden ranges.
Set xName =ThisWorkbook.Names("Product").RefersToRange.SpecialCells(xlCellTypeVisible)
For i = 1 to xName.Areas.Count
For j = 1 to XName.Areas(i).Count
Debug.Print i, j, XName.Areas(i).Cells(j)
Next
Next
Related
I'm trying to fill blank cells in a certain region with 0. The reagion should be defined in the current workbook but in sheet2 (not the current sheet). Also the place where it is supposed to fill is between columns
BU:CQ in the current region (not all 100 000 000 lines). Just the number of lines that define the table between columns BU and CQ. I know the problem lies in defining the region... See the code below.
What is missing?
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = "0"
For Each cell In ThisWorkbook.Sheets("Sheet2").Range(BU).CurrentRegion
'.Cells(Rows.Count, 2).End(xlUp).Row
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub
I've this code that i'm positive that works! But i don't wnat selection! I want somthing that specifies the sheet and a fixed range.
Now my idea is to replace "selection" with the desired range. - In this case in particular the range should be 1 - between BU:CQ; 2 - starting at row 2; 3 - working the way down until last row (not empty = end of the table that goes from column A to DE)
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "0"
End If
Next
End Sub'
PS: And I also need to specify the sheet, since the button that will execute the code will be in the same workbook but not in the same sheet.
Use SpecialsCells:
On Error Resume Next 'for the case the range would be all filled
With ws
Intersect(.UsedRange, .Range("BU:CQ")).SpecialCells(xlCellTypeBlanks).Value = 0
End With
On Error GoTo 0
MUCH faster than looping !
Try using cells() references, such as:
For i = cells(1,"BU").Column to cells(1,"CQ").Column
cells(1,i).value = "Moo"
Next i
In your current code you list Range(BU) which is not appropriate syntax. Note that Range() can be used for named ranges, e.g., Range("TheseCells"), but the actual cell references are written as Range("A1"), etc. For Cell(), you would use Cells(row,col).
Edit1
With if statement, with second loop:
Dim i as long, j as long, lr as long
lr = cells(rows.count,1).end(xlup).row
For i = 2 to lr 'assumes headers in row 1
For j = cells(1,"BU").Column to cells(1,"CQ").Column
If cells(i,j).value = "" then cells(i,j).value = "Moo"
Next j
Next i
First off, you should reference the worksheet you're working with using:
Set ws = Excel.Application.ThisWorkbook.Worksheets(MyWorksheetName)
Otherwise VBA is going to choose the worksheet for you, and it may or may not be the worksheet you want to work with.
And then use it to specify ranges on specific worksheets such as ws.Range or ws.Cells. This is a much better method for specifying which worksheet you're working on.
Now for your question:
I would reference the range using the following syntax:
Dim MyRange As Range
Set MyRange = ws.Range("BU:CQ")
I would iterate through the range like so:
Edit: I tested this and it works. Obviously you will want to change the range and worksheet reference; I assume you're competent enough to do this yourself. I didn't make a variable for my worksheet because another way to reference a worksheet is to use the worksheet's (Name) property in the property window, which you can set to whatever you want; this is a free, global variable.
Where I defined testWS in the properties window:
Public Sub test()
Dim MyRange As Range
Dim tblHeight As Long
Dim tblLength As Long
Dim offsetLen As Long
Dim i As Long
Dim j As Long
With testWS
'set this this to your "BU:CQ" range
Set MyRange = .Range("P:W")
'set this to "A:BU" to get the offset from A to BU
offsetLen = .Range("A:P").Columns.Count - 1
'set this to your "A" range
tblHeight = .Range("P" & .Rows.Count).End(xlUp).Row
tblLength = MyRange.Columns.Count
End With
'iterate through the number of rows
For i = 1 To tblHeight
'iterate through the number of columns
For j = 1 To tblLength
If IsEmpty(testWS.Cells(i, offsetLen + j).Value) Then
testWS.Cells(i, offsetLen + j).Value = 0
End If
Next
Next
End Sub
Before:
After (I stopped it early, so it didn't go through all the rows in the file):
If there's a better way to do this, then let me know.
I have 10 records in excel of which i have edited 3rd and 7th records and placing a flag/string "modified" in certain column belongs to same rows to filter while processing
Below is the code that i am working with which is fetching only the first record(3rd) and not the 7th record into array using VBA
Dim RecordsArray() As Variant
Set sht = ThisWorkbook.Sheets("RMData")
sht.Range("M1:M100").AutoFilter Field:=1, Criteria1:="Modified"
sht.Range("A2:A100").Rows.SpecialCells (xlCellTypeVisible)
col = [a2].CurrentRegion.Columns.count
lw = [a2].End(xlDown).Row
RecordsArray = Range(Cells(2, 1), Cells(lw,col)).SpecialCells(xlCellTypeVisible)
Idea is I want to get those two records without looping and searching for
"Modified" string for the edited row
When reading a Filtered Range, most likely there will be splits ranges, the rows will not be continuous, so you need to loop through the Areas of the Filtered Range.
Also, you might have a few Rows in each Area, so you should loop through the Area.Rows.
More detailed comments in my code below.
Code
Option Explicit
Sub Populated2DArrayfromFilterRange()
Dim RecordsArray() As Variant
Dim sht As Worksheet
Dim col As Long, lw As Long, i As Long
Dim FiltRng As Range, myArea As Range, myRow As Range
ReDim RecordsArray(0 To 1000) ' redim size of array to high number >> will optimize later
' set the worksheet object
Set sht = ThisWorkbook.Sheets("RMData")
i = 0 ' reset array element index
' use With statement to fully qualify all Range and Cells objects nested inside
With sht
.Range("M1:M100").AutoFilter Field:=1, Criteria1:="Modified"
.Range("A2:A100").Rows.SpecialCells (xlCellTypeVisible)
col = .Range("A2").CurrentRegion.Columns.Count
lw = .Range("A2").End(xlDown).Row
' set the filtered range
Set FiltRng = .Range(.Cells(2, 1), .Cells(lw, col)).SpecialCells(xlCellTypeVisible)
' Debug.Print FiltRng.Address(0, 0)
For Each myArea In FiltRng.Areas ' <-- loop through areas
For Each myRow In myArea.Rows ' <-- loop through rows in area
RecordsArray(i) = Application.Transpose(Application.Transpose(myRow))
i = i + 1 ' raise array index by 1
Next myRow
Next myArea
ReDim Preserve RecordsArray(0 To i - 1) ' optimize array size to actual populated size
End With
End Sub
If you have a hidden row in the middle, then .SpecialCells(xlCellTypeVisible) will return multiple Areas. Assigning a range to an Array only assigns the first Area. (At also always makes the array 2D)
Instead of looping & searching for "Modified", you could just loop For Each cell in the SpecialCells range and assign that to the array instead - if you plan was "no loops at all" then this is not what you want. (But, I would then have to ask you "why not?"!)
Dim RecordsArray() As Variant, rFiltered As Range, rCell As Range, lCount As Long
Set sht = ThisWorkbook.Sheets("RMData")
sht.Range("M1:M100").AutoFilter Field:=1, Criteria1:="Modified"
sht.Range("A2:A100").Rows.SpecialCells (xlCellTypeVisible)
col = [a2].CurrentRegion.Columns.Count 'This will act on ActiveSheet, not sht - is that intended?
lw = [a2].End(xlDown).Row 'In case of gaps, would "lw=sht.Cells(sht.Rows.Count,1).End(xlUp).Row" be better?
'RecordsArray = Range(Cells(2, 1), Cells(lw, col)).SpecialCells(xlCellTypeVisible)
Set rFiltered = Range(Cells(2, 1), Cells(lw, col)).SpecialCells(xlCellTypeVisible)
ReDim RecordsArray(1 To rFiltered.Cells.Count, 1) 'Mimic default assignment
lCount = 1
For Each rCell In rFiltered
RecordsArray(lCount, 1) = rCell.Value
lCount = lCount + 1
Next rTMP
Set rCell = Nothing
Set rFiltered = Nothing
If you want to avoid dealing with the visible areas mentioned already, you can try something like this
Option Explicit
Public Sub CopyVisibleToArray()
Dim recordsArray As Variant, ws As Worksheet, nextAvailable As Range
Set ws = ThisWorkbook.Worksheets("RMData")
Set nextAvailable = ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(2)
With ws.Range("M1:M100")
Application.ScreenUpdating = False
.AutoFilter Field:=1, Criteria1:="Modified"
If .Rows.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
'copy - paste visibles in col A, under all data
ws.UsedRange.Columns("A:M").SpecialCells(xlCellTypeVisible).Copy nextAvailable
Set nextAvailable = nextAvailable.Offset(1)
nextAvailable.Offset(-1).EntireRow.Delete 'Delete the (visible) header
recordsArray = nextAvailable.CurrentRegion 'Get the cells as array
nextAvailable.CurrentRegion.EntireRow.Delete 'Delete the temporary range
End If
.AutoFilter
Application.ScreenUpdating = True
End With
End Sub
To copy just column A to array use this: ws.UsedRange.Columns("A")
To copy columns A to M use this: ws.UsedRange.Columns("A:M")
I'm trying to create a macro in VBA that will search through a column in "PasteSheet" for any cell that contains the word "conversion". Once I have that cell, I can gather other information in other columns that correspond to that row. The problem I am encountering is creating some type of loop that will run through the entire database to return all instances of the word "conversion". Here is my code so far:
Sub Conversion()
Dim Comment As Range
Dim i As String
Worksheets("PasteSheet").Activate
Range("Comment").Find("conversion").Select
Worksheets("sheet1").Range("a1") = Selection.Offset(0, -8)
End Sub
Help please!
Here's one way you can do it. This will save the addresses of the found word in an array, and you can use that array however you like at the end. I used column D as my example column. Change anything as necessary
Sub getCells()
Dim rng As Range, cel As Range
Dim celAddress() As Variant
Dim i As Long
i = 0
Set rng = Range("D1:D" & Cells(Rows.Count, 4).End(xlUp).Row)
ReDim cellAddress(rng.Cells.Count)
For Each cel In rng
If cel.Value = "conversion" Then
cellAddress(i) = cel.Address
i = i + 1
End If
Next cel
ReDim Preserve cellAddress(i - 1)
For i = LBound(cellAddress) To UBound(cellAddress)
' Do whatever with each cell address found
Debug.Print cellAddress(i)
Next i
End Sub
How to find location of last cell from defined Range? Cell does not have to contain any data but must be most right and most down located cell from certain Range.
Set rngOrigin = wksOrigin.Cells(IntFirstRow, IntFirstColumn).CurrentRegion
I wish to receive
Cells(i,j)
Perhaps this is what you want:
Dim rngLastCell As Range
Set rngLastCell = rngOrigin(rngOrigin.Count)
maybe you're after this:
'absolute indexes from cell A1
With rngOrigin
i = .Rows(.Rows.count).row
j = .Columns(.Columns.count).Column
End With
'relative indexes from rngOrigin upleftmost cell
With rngOrigin
i = .Rows(.Rows.count).row - .Rows(1).row + 1
j = .Columns(.Columns.count).Column - .Columns(1).Column + 1
End With
I handled it in below code but your remarks were helpful. Thank you.
intLastRow = rngOrigin.Cells(1, 1).Row + rngOrigin.Rows.Count - 1
intLastCol = rngOrigin.Cells(1, 1).Column + rngOrigin.Columns.Count - 1
The answers given by others mostly work, but not if the region is a union of non-contiguous cells. Here is a version that works consistently for single and multi-area regions, contiguous and non-contiguous.
Function LastCellOfRange(rng As Excel.Range) As Excel.Range
Dim area As Excel.Range
Dim rowNum As Long
Dim maxRow As Long
Dim colNum As Long
Dim maxCol As Long
Dim areaIdx As Integer
Set LastCellOfRange = Nothing
maxRow = 0
maxCol = 0
For areaIdx = 1 To rng.Areas.Count
Set area = rng.Areas(areaIdx)
rowNum = area.Cells(area.Cells.Count).row
If (rowNum > maxRow) Then
maxRow = rowNum
End If
colNum = area.Cells(area.Cells.Count).Column
If (colNum > maxCol) Then
maxCol = colNum
End If
Next areaIdx
Set LastCellOfRange = rng.Worksheet.Cells(maxRow, maxCol)
Set area = Nothing
End Function
Use this to code find the last cell in a given range
Sub GetLastCellFromRange()
Dim rng As Range
Set rng = Range("$C$10:$E$20")
'Set rng = Range(Selection.Address) ' Use this line to select the range in worksheet
MsgBox "Last Cell of given range is : " & rng.Cells(rng.Rows.Count, rng.Columns.Count).Address
End Sub
I hope it will help you
you could try the following but it relies upon cells always being populated
rngOrigin.End(xlDown).End(xlRight)
or you could use the CurrentRegion and count the rows and columns and use Offset
Alternatively, you could use this construct which works even with ranges based on entire rows or entire columns.
Sub Test()
Dim rngOrigin As Excel.Range
Set rngOrigin = Range("$A$1:$D$6")
Dim rngLast As Excel.Range
Set rngLast = rngOrigin.Cells(rngOrigin.Cells.Count)
Debug.Print rngLast.Address
End Sub
Finally, for ranges with multiple areas you'll have to script against a range's Areas collection ...
Sub Test()
Dim rngOrigin As Excel.Range
Set rngOrigin = Range("$A$1:$D$6,$F$1:$G$6")
Debug.Print rngOrigin.Areas(1).Cells(rngOrigin.Areas(1).Cells.Count).Address
Debug.Print rngOrigin.Areas(2).Cells(rngOrigin.Areas(2).Cells.Count).Address
End Sub
Many answers here will work as long as the given range is continuous. This is what I would use for a range that you are absolutely sure is going to be continuous:
Sub test()
Dim myRng As Range, lastCell As Range
Set myRng = Range("A1:D4")
Set lastCell = myRng.Cells(myRng.Rows.Count, myRng.Columns.Count)
Debug.Print lastCell.Address 'returns $D$4
End Sub
For non-continuous, DB user10082797 gave a great solution, however their function fails when the ranges are positioned diagonal-up (for example, if you pass rng=A3:B4,C1:D2 in you will get D4 as the output which was not part of the original range.)
So the question becomes, what is the last cell in the range A3:B4,C1:D2? Is it B4 or D2? That's a decision for the programmer. Here is a function I wrote with the help of DB user10082797's function:
Function LastCellOfRange(rng As Range, Optional returnLastRow As Boolean = True) As Range
'returns the last cell in #rng.
'if #returnLastRow is TRUE, then the output will always be in the right most cell of the last row of #rng
'if #returnLastRow is FALSE, then the output will always be in the bottom most cell of the last column of #rng
'(#returnLastRow only matters for non-contiguous ranges under certain circumstances.)
'initialize variables
Dim area As Range, areaIdx As Long
Dim lastCellInArea As Range
'loop thru each area in the selection
For areaIdx = 1 To rng.Areas.Count
Set area = rng.Areas(areaIdx) 'get next area
Set lastCellInArea = area.Cells(area.Rows.Count, area.Columns.Count) 'get the last cell in the area
'if:
' the return is empty
' OR if the last row needs to be returned and this row is larger than the last area's
' OR if the last row needs to be returned and this row is the same as the last area's but has a larger column
' OR if the last column needs to be returned and this column is larger than the last area's
' OR if the last column needs to be returned and this column is the same as the last area's but has a larger row
'THEN:
' make this cell the return range
If LastCellOfRange Is Nothing Then
Set LastCellOfRange = lastCellInArea '(must be seperate from the other statment when its not set to anything)
ElseIf _
returnLastRow = True And lastCellInArea.Row > LastCellOfRange.Row _
Or returnLastRow = True And lastCellInArea.Row = LastCellOfRange.Row And lastCellInArea.Column > LastCellOfRange.Column _
Or returnLastRow = False And lastCellInArea.Column > LastCellOfRange.Column _
Or returnLastRow = False And lastCellInArea.Column = LastCellOfRange.Column And lastCellInArea.Row > LastCellOfRange.Row _
Then
Set LastCellOfRange = lastCellInArea
End If
Next areaIdx
End Function
You can use the function like this:
Sub test()
Dim myRng As Range
Set myRng = Range("A3:B4,C1:D2")
Debug.Print LastCellOfRange(myRng).Address 'returns $B$4
Debug.Print LastCellOfRange(myRng, False).Address 'returns $D$2
End Sub
In your case, since you want to find the cell to the most right and down in your wksOrigin (defined as Worksheet), you could use the SpecialCells(xlCellTypeLastCell) to get the last cell Row and Column.
i = wksOrigin.Cells.SpecialCells(xlCellTypeLastCell).Row ' <-- get last row number
j = wksOrigin.Cells.SpecialCells(xlCellTypeLastCell).Column ' <-- get last column number
If you want to debug your result, you can add:
MsgBox "Last row at " & i & ", last column at " & j
If you want the absolute last cell of a defined range, regardless of whether it has any content, here is a simple solution
Dim InputRng As Range 'define a range for the test'
Set InputRng = Range("$F$3:$F$15")
MsgBox InputRng(1).Address & ":" & InputRng(InputRng.Cells.Count).Address 'This would output the absolute address of defined range'
I am trying to use the following VBA code to do two things.
Count the number of unique visible rows in a filtered worksheet.
Delete the duplicate rows
So far:
Function UniqueVisible(MyRange As Range) As Integer
Dim ws As Worksheet
Set ws = Worksheets(1)
Dim R As Range
Dim V() As String
ReDim V(0 To MyRange.Count) As String
For Each R In MyRange
If (R.EntireRow.Hidden = False) Then
For Index = 0 To UniqueVisible
If (V(Index) = R.Value) Then
R.Delete
Exit For
End If
If (Index = UniqueVisible) Then
V(UniqueVisible) = R.Value
UniqueVisible = UniqueVisible + 1
End If
Next
End If
Next R
End Function
This counts okay, and if I replace R.Delete with MsgBox(R.Row) I get the correct row number of the duplicate.
R.Delete does nothing.
R.EntireRow.Delete does nothing
ws.Rows(R.Row).Delete does nothing.
UPDATE
This doesn't seem to be working
Function UniqueVisible(MyRange As Range) As Integer
Dim ws As Worksheet
Set ws = Worksheets(1)
Dim R As Range
Dim Dup As Integer
Dup = 0
Dim Dups() As Integer
ReDim Dups(0 To MyRange.Count) As Integer
Dim V() As String
ReDim V(0 To MyRange.Count) As String
For Each R In MyRange
If (R.EntireRow.Hidden = False) Then
For Index = 0 To UniqueVisible
If (V(Index) = R.Value) Then
Dups(Dup) = R.Row
Dup = Dup + 1
Exit For
End If
If (Index = UniqueVisible) Then
V(UniqueVisible) = R.Value
UniqueVisible = UniqueVisible + 1
End If
Next
End If
Next R
For Each D In Dups
ws.Rows(D).Delete
Next D
End Function
It seems you're breaking a few rules here.
You cannot use a function to delete rows in VBA. It does not matter whether you are using the function as a User Defined Function (aka UDF) on the worksheet or calling it from a sub in a VBA project. A function is meant to return a value, not perform operations that modify the structure (or even the values other than its own cell) on a worksheet. In your case, it could return an array of row numbers to be deleted by a sub.
It is considered canonical practise to start from the bottom (or the right for columns) and work up when deleting rows. Working from the top to the bottom may skip rows when a row is deleted and you loop to the next one.
Here is an example where a sub calls the function to gather the count of the unique, visible entries and an array of rows to be removed.
Sub remove_rows()
Dim v As Long, vDelete_These As Variant, iUnique As Long
Dim ws As Worksheet
Set ws = Worksheets(1)
vDelete_These = UniqueVisible(ws.Range("A1:A20"))
iUnique = vDelete_These(LBound(vDelete_These))
For v = UBound(vDelete_These) To (LBound(vDelete_These) + 1) Step -1 'not that we are working from the bottom up
ws.Rows(vDelete_These(v)).EntireRow.Delete
Next v
Debug.Print "There were " & iUnique & " unique, visible values."
End Sub
Function UniqueVisible(MyRange As Range)
Dim R As Range
Dim uniq As Long
Dim Dups As Variant
Dim v As String
ReDim Dups(1 To 1) 'make room for the unique count
v = ChrW(8203) 'seed out string hash check with the delimiter
For Each R In MyRange
If Not R.EntireRow.Hidden Then
If CBool(InStr(1, v, ChrW(8203) & R.Value & ChrW(8203), vbTextCompare)) Then
ReDim Preserve Dups(1 To UBound(Dups) + 1)
Dups(UBound(Dups)) = R.Row
Else
uniq = uniq + 1
v = v & R.Value & ChrW(8203)
End If
End If
Next R
Dups(LBound(Dups)) = uniq 'stuff the unique count into the primary of the array
UniqueVisible = Dups
End Function
Now, that is probably not how I would go about it. Seems easier to just write the whole thing into a single sub. However, understanding processes and limitations is important so I hope you can work with this.
Note that this does not have any error control. This should be present when dealing with arrays and deleting row in loops.
You can't delete a row while you're looping through the rows. You'll need to store the rows that need to be deleted in an array, and then loop through the array and delete the rows after it's done looping through the rows.