I am returning a Excel.range of a listObject (Excel table), based upon the visible rows, using this kind of syntax (where pLO is a list object):
Set returnUniqueList = pLO.range.SpecialCells(xlCellTypeVisible).EntireRow
This is happening AFTER I do an advanced filter on a column. I can see that the advanced filter has worked, and is returning the correct number of rows through visual inspection.
The problem is that the above code snippet returns a range with many areas, which might contain overlapping rows in the areas! So if I iterate through all the areas in the returned range, I get duplicates. How can I either only return the visible rows, or filter out the duplicates during the iteration that follows?
EDIT***************************************************
Erik, some more information regarding the overlapping. the returnUniqueList range above will have numerous 'Area' objects contained within it. These could number from 1 to n, where 'n' can exceed the number of visible rows in my original table.
Each of these Areas is also a range (so could also contain areas 1..n!!!). Looking at the rows in these areas, Area(1) could contain identical rows to Area(2)!
END EDIT************************************************
I can't do an advanced filter to a different range, because I need to return the table worth of filtered table.
I hope this makes sense.
Cheers,
LazzMaTazz
Try same without the .EntireRow as in:
'Set returnUniqueList = pLO.range.SpecialCells(xlCellTypeVisible).EntireRow
Set returnUniqueList = pLO.range.SpecialCells(xlCellTypeVisible)
and see what the Areas are, and if there are yet any overlapping rows in this result.
The solution I've come up with to this problem is to create a new worksheet in my workbook, and copy the filtered table into this new worksheet.
This always (in my testing with various tables so far) seems to copy the filtered table from the source worksheet into contiguous rows in the temporary destination worksheet. This then returns a range object with a single 'area', which can be used reliably.
I have to be careful to:
make sure I clean the temporary worksheet up when I'm finished working with the data
clear the temporary worksheet cells after each operation so old data doesn't cause me problems.
Private Function copyToNewWorkSheet() As Excel.range
' call this when the sourcesheet (pWkSht) is already filtered.
Dim myWkBk As New Excel.Workbook
Dim tempWs As New Excel.Worksheet
' if the first time this is called, create the new worksheet
If WorksheetExists("TempWorkSheet") Then
Set tempWs = pMyWkBk.Worksheets("TempWorkSheet")
Else
Set tempWs = pMyWkBk.Worksheets.Add(After:=pMyWkBk.Worksheets(pMyWkBk.Worksheets.Count))
tempWs.Name = "TempWorkSheet"
End If
' clear the temp worksheet contents
tempWs.Cells.Clear
' reselect my source worksheet (which is already filtered)
pWkSht.Select
' it falls over sometimes if this isn't here - any thoughts???
pWkSht.range("A1", pWkSht.Cells(pWkSht.rows.Count, "A").End(xlUp)).Select
' copy the required from the course worksheet, using information from the table (pLO) on the worksheet
pWkSht.range("A1", pWkSht.Cells(pLO.range.Areas(pLO.range.Areas.Count).rows.Count, "A")).Resize(, pLO.range.Columns.Count).Copy tempWs.range("A1")
' return the 'clean' range from the temporary worksheet
Set copyToNewWorkSheet = tempWs.range("A1", tempWs.Cells(tempWs.rows.Count, "A").End(xlUp)).Resize(, pLO.range.Columns.Count)
End Function
I can upload a workbook if anyone would like to see the solution in full. This problem has taken me a few days to solve - so please feel free to ask!
LazzMaTazz
Related
I have a sheet named "Staffdb" with two named tables "PermTBL" and "StaffTBL", same headers "Girls" "ID" "Hire_date" and "Status". All of the current and historic staff are in PermTBL. I would like to filter PermTBL on the Status field for "A" meaning active and then copy these to the StaffTBL which is empty. After manually filtering the PermTBL with the Status down arrow and select only "A" I go in to test the code and get an apparent partial copy. My code is
Option Explicit
Sub PermTBLtoStaffTBL()
Dim rgnsrc As Range
Dim rgndest As Range
Set rgnsrc = Worksheets("Staffdb").Range("PermTBL")
Set rgndest = Worksheets("Staffdb").Range("StaffTBL")
rgnsrc.SpecialCells(xlCellTypeVisible).Copy rgndest
End Sub
Finally as an additional piece of information the StaffTBL appears to have hidden rows, 3-7 are not visible which appears to correspond with my missing data. I have tried to unhide to no avail. Suggestions as to where to go next? Must I loop through the table or have I made an error in my destination? New at this, and 3rd world internet speed, along with inability to have books delivered makes this a tedious process. Please bear with the NewBee.
New piece of information, I have found that if I unhide the entire sheet the correct data appears in the StaffTBL, of course the filter of the PermTBL also disappears, so apparently I was on the right track. Would still like comments and suggestions on programmatically (as opposed to manually) filtering PermTBL. I will continue to search sites for that, but any suggestions are appreciated.
Sub CopyData()
Dim t As ListObject
Dim t2 As ListObject
Set t = ActiveSheet.ListObjects("PermTBL")
Set t2 = ActiveSheet.ListObjects("StaffTBL")
' Remove all rows from StaffTBL table
If Not t2.DataBodyRange Is Nothing Then
t2.DataBodyRange.Rows.Delete
End If
' Filter Status by "A"
t.DataBodyRange.AutoFilter Field:=4, Criteria1:="A"
' Copy to first cell right below the table's header
t.DataBodyRange.Copy t2.Range(1).Offset(1)
' Remove filter from PermTBL table
t.DataBodyRange.AutoFilter
End Sub
UPDATE
Example workbook
I am new to using VBA and would like to add coding to a button that will identify the size of a table called "QA_Activity" and clear all but the header row on clicking the button. I was hoping that this would be quite simple but am struggling as to how to identify a table that could be a different size each month. Many thanks in advance.
Tables are called ListObjects in VBA. A ListObject has a property called a .DataBodyRange that contains everything under the header. That has a .Clear method.
I generally use this syntax to clear the body of a ListObject:
Range("Table1").ListObject.DataBodyRange.Clear
The Range("Table1") bit allows me to find the ListObject even if I don't know what sheet it's on. This works because Tables are also Named Ranges that you can address by name. So you just say "Go to the Named Range called Table1, and get me the ListObject that lives there". Otherwise you would need to know in advance what sheet the ListObject is on, and use the following:
Worksheets("SomeSheet").Listobjects("Table1").DataBodyRange.Clear
...which works just fine until one day you move the Table to a different sheet, and forget to update your code.
Note that a table is not guaranteed to actually have a .DataBodyRange, because someone may have deleted all the rows under the header. For instance, take this Table:
How many rows does it have in the DataBodyRange?
? Range("Table1").ListObject.DataBodyRange.Rows.Count
3
Okay, now I'm going to delete those rows:
...leaving this:
How many rows in that DataBodyRange now?
? Range("Table1").ListObject.DataBodyRange.Rows.Count
Whoops...you can't reference a .DataBodyRange if it don't exist.
So to be safe, stick an On Error Resume Next before you try to reference a .DataBodyRange, and an On Error Goto 0 afterwards. Or something fancier.
First, create a named range. If required, you can make this dynamic. In this example the named range is Name "Data".
Then Trigger the Sub "Test" from the following VBA code.
Option Explicit
Sub ClearRange(ByVal rngCell As Range)
Dim rngRange As Range
Set rngRange = rngCell.CurrentRegion
rngRange.Range(rngRange.Parent.Cells(2, 1), rngRange.Parent.Cells(rngRange.Rows.Count, rngRange.Columns.Count)).ClearContents
End Sub
Sub test()
Dim rngCell As Range
Set rngCell = ActiveSheet.Range("Data").Cells(1, 1)
ClearRange rngCell
End Sub
This should clear the range except for the first row (headers).
Important: The header row and the first column of your range must be filled completely (no empty cells) for the above to work smoothly.
I have a monster of a workbook that I'm trying to make more manageable for those that use it after me. I have a ton of code that is ran when buttons are pressed to make it more user friendly to those that know little to nothing of Excel. So here is where I need help.
I have several sheets with similar tables. My first sheet contains a Master List of customer information and pressing a button, copies this information to each other sheet and sorts it to categorize these customers on their respective sheets. This allows me to enter new information only on the first sheet and have it auto-populate the sheets correctly to minimize human error.
To cut down on a lot of the errors, I utilized structured referencing in tables. I didn't originally have it this way, but I've been trying to improve this workbook over time.
Anyway, so I have a column "Charge Type" in each table, and the total column references it as
[#[Charge Type]]
which is great, considering customers will be added and removed pretty regularly and this cuts down on errors.
However, when this formula gets copied to one of the other sheets, it's converted over to
All_List[#[Charge Type]]
which adds the name of the table on sheet1, which is "All_List". Now I want it to refer to the column "Charge Type" specifically in the new table on the new sheet, and I cannot for the life of me figure out how.
This solution uses a variable to hold the ListObject "Field" formula then loops trough all other ListObjects in the same workbook with the same "Field" and applies the formula to that "Field".
ListObjects before
Sub ListObjects_Formula_Copy()
Dim wsh As Worksheet
Dim lob As ListObject
Dim rTrg As Range
Dim sFld As String
Dim sFmlR1C1 As String
Rem Get Formula from Primary ListObject
sFld = "Price" 'Change as required
Set lob = ThisWorkbook.Sheets("Sht(0)").ListObjects(1) 'Change as required
sFmlR1C1 = lob.ListColumns(sFld).DataBodyRange.Cells(1).FormulaR1C1
Rem Apply Formula to Other ListObjects
For Each wsh In ThisWorkbook.Worksheets
If wsh.Name <> "Sht(0)" Then
For Each lob In wsh.ListObjects
Rem Validate Field
Set rTrg = Nothing
On Error Resume Next
Set rTrg = lob.ListColumns(sFld).DataBodyRange
On Error GoTo 0
Rem Applies Formula
If Not (rTrg Is Nothing) Then rTrg.FormulaR1C1 = sFmlR1C1
Next: End If: Next
End Sub
ListObjects after
I have the following raw table structure - a list of credit card transactions:
Date | Description | Debits | Credits
Date will be converted using this approach:
Ensure a valid date inside the cell in Excel
Other columns will stay AS IS. I can create the first row of a target table, but I need to expand it downwards to match the number of rows in the source table.
Is there a way to automate the last part, i.e. row expansion?
I am expecting the raw data table to grow over time, so the target table needs to adjust its row count as well (either fully automated or via a single-click macro).
There is a similar question on StackOverflow, but I am using named tables and named columns:
Matching number of rows in one excel table with the number of rows in another
Table names:
Source : TableRawData
Target : ProcessedData
Date conversion formula I am using in the 1st column:
=MorphDate(TableRawData[#Date])
Paste this code into the worksheet with the source Table (ListObject). I used the Table names you specified. You'll need to adjust the worksheet names to the actual ones in your workbook:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim loSource As Excel.ListObject
Dim loTarget As Excel.ListObject
Dim wb As Excel.Workbook
Set wb = ThisWorkbook
With wb
Set loSource = .Worksheets("Source").ListObjects("TableRawData")
Set loTarget = .Worksheets("Target").ListObjects("ProcessedData")
'Only change Target if Source has more rows or columns, i.e,
'don't shrink, only grow.
If loTarget.Range.Rows.Count < loSource.Range.Rows.Count Or _
loTarget.Range.Columns.Count < loSource.Range.Columns.Count Then
With loTarget
'two kinds of 'Resize in one line!
.Resize (.Range.Cells(1).Resize(loSource.Range.Rows.Count, loSource.Range.Columns.Count))
End With
End If
End With
End Sub
As noted in the comments this triggers if either the number of rows or columns gets bigger. If you want it to change if Target grows or shrinks then change the <'s to <>'s.
If you are interested in the two different Resizes used in the code, and some information on copying Tables, see my this post of mine.
I must be having a brain fog at this point because I am certain this is easy to do, and in fact I have managed to create other functions that are a bit more complicated for this project.
Anyway, what I am trying to do. I have a sheet (inventory-data) and in column 1, it lists a company name, which is a same for all the rows. i.e. each of the 1900 or so rows have companyname in the first cell.
Now, while the data will always be the same at each application, the number of rows will change.
So, I need a function that will first determine what the last row of data is in the range, and then change all of the cells in column one of each record to name_company. The company names will always be the same so I can staticly assign them. Here is what I have that does not work.
I was able to get it to work another way, but it would replace text all the way down to the very last row of the worksheet, way beyond where the data stops.
Thanks!
Sub changeCompany() 'Changes company name as pulled from Agemni into proper ETA format
Dim myCell As Range
Dim RngToChange As Range 'The range of cells that need to be changed
Dim LastRow As Long 'Declare variable to help determine the last row on a variable length worksheet
Dim i As Integer
With Worksheets("inventory-data") 'set the range to change
Set RngToChange = .Columns(1)
End With
LastRow = Worksheets("inventory-data").UsedRange.Rows.Count 'Have Excel determine what the last row is.
For i = LastRow To 1 Step -1
RngToChange.Cells.Value = "name_company"
Next i
End Sub
I've always had more success with [SomeCellOrRange].CurrentRegion.Rows.Count e.g:
Range("A1").CurrentRegion.Rows.Count
UsedRange looks for any use of cells, not limited to a continuous tabular block. It also sometimes needs you to re-save the workbook before it will properly shrink after you have eliminated some rows.