I have a table in Sheet 2 with a name "MyTable". Number of rows of that table changes each time depending on the data. I would like to clear the contents of the table and resize it using a macro so that it has only two rows- a title row, and an empty row.
Table title row is from B5 until K5.
I tried the below code, it clears the table contents and resizes, however, does not resize as desired. It resizes, without clearing the table borders in column C.
Any help is really appreciated.
Sub Table_Resize()
Dim rng as Range
Sheet2.Select
Range("MyTable").ClearContents
Set rng = Range("MyTable[#All]").Resize(2, 10)
Sheet2.ListObjects("MyTable").Resize rng
End Sub
I think that what you are trying to do is to delete the all rows.
Sub Table_ClearContents_Resize()
Dim ws As Worksheet: Set ws = Sheets("Sheet2")
Dim ol As ListObject: Set ol = ws.ListObjects("MyTable")
' Delete table contents
ol.DataBodyRange.ClearContents
' Resize table
ol.Resize Range(ol.HeaderRowRange.Resize(2).Address)
End Sub
Related
I have a table below another table.
If I add a lot of values in the first table, the second table will change cells and go further below.
Sub Macro4()
Range("Table2[Work]").Select
Selection.ListObject.ListRows.Add (1)
Range("A24").Value = Now
Range("B24").Value = VBA.Environ("Username")
End Sub
I'm using range (A24 and B24) to add values. I would rather have them follow up the table whatever it's location instead of hardcoding it.
Write to the Last Row of a Table
If you're trying to write to the last row of a table, try the following. Adjust the worksheet name though.
The Code
Option Explicit
Sub NewTableEntry()
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1") ' The worksheet containing the table.
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table2")
' If you fully understand the previous, then rather use the following:
'Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table2")
' Add a new row to the bottom of the table.
tbl.ListRows.Add
' Write values to the last row in the table.
With tbl.DataBodyRange.Rows(tbl.DataBodyRange.Rows.Count)
.Cells(1).Value = Now
.Cells(2).Value = VBA.Environ("Username")
End With
End Sub
I am adding a new row to a table but want to then add the data to that row that I just added. I am thinking something like this, but not sure how to add each columns data to that new row. My table has 4 columns named "store" "emp#" "date" & "amt". I have specific data that I will put in each column. I simplified the code, as there is a whole lot more to the macro, but just stuck on this part. Thank you for you help.
Dim rt_ws As Worksheet
Dim rt_tbl As ListObject
Set rt_ws = ThisWorkbook.Worksheets("RT Clock Hours")
Set rt_tbl = rt_ws.ListObjects("rt_hours")
With rt_table.ListRows.Add
. `this is where I am not sure what to do`
.
.
End Sub
Try this code
Sub Test()
Dim ws As Worksheet, tbl As ListObject
Set ws = ThisWorkbook.Worksheets("RT Clock Hours")
Set tbl = ws.ListObjects("rt_hours")
With tbl.ListRows.Add
.Range = Array("Store1", "1530", "05/03/2020", "Amt1")
End With
End Sub
I am using this code to set a range of filtered table to visible cells only.
Set rngMyRange = Selection.SpecialCells(xlCellTypeVisible)
However, there is a strange bug if only one cell is selected, that is, the code selects all used range in the filtered table.
If the selection is greater than one cell, then the code works as expected. Is there a way around this?
Usually using "Selection" is not a good practice; I am guessing you just need to get the range of the visible cells for that you can easily use this:
Sub GetVisibleRangeOnly()
Dim tbl As ListObject
Dim rng As Range
'change the name of the table and worksheet as you need
Set tbl = Worksheets("Sheet1").ListObjects("Table1")
'Note: if there is no visible cell after filtraton rng IS NOTHING will be TRUE
Set rng = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
End Sub
I am hoping someone can help me figure out a really annoying aesthetic feature of pivot tables in Excel.
Here is what my current "analysis" screen looks like without the pivot tables:
However, I have placed pivot tables in the black boxes and have a macro to auto update them after I import more data. That is below:
Sub UpdatePivots()
' This sub is intended to update all pivot charts in the by switching to the appropriate
' worksheet, locating the appropriate pivot table, and updating them.
Dim ws As Worksheet
Dim PT As PivotTable
Dim pvtItem As PivotItem
For Each ws In ActiveWorkbook.Worksheets '<~~ Loop all worksheets in workbook
For Each PT In ws.PivotTables '<~~ Loop all pivot tables in worksheet
PT.PivotCache.Refresh
Next PT
Next ws
End Sub
However, the imported data changes. Sometimes it is very small, sometimes it is very large, and so I end up with my pivot tables looking like this:
How is it possible for me to either write code, or change settings, so those ugly white rows don't appear? I would like for the gray to remain if there are no pivot rows. I have tried checking in Pivot Table formatting settings but have been unsuccessful.
You can use a standard last row identifier and then color your interior cells below. You will need to pick a max row number (here it always color form last row down to 100, so change 100 if needed). You will also need to set the columns since you have a black border.
Last, you will just need to add the color code. I added a bit of code below to extract the color code if you don't know what it already.
This solution will work for the left pivot. You will need to duplicate the two lines of code I added for the pivot on right.
Sub UpdatePivots()
Dim ws As Worksheet
Dim PT As PivotTable, pvtItem As PivotItem
Dim LRow As Long
For Each ws In ActiveWorkbook.Worksheets
For Each PT In ws.PivotTables
PT.PivotCache.Refresh
LRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Offset(1).Row
ws.Range(ws.Cells(LRow, "D"), ws.Cells(100, "G")).Interior.Color = 11184814
Next PT
Next ws
End Sub
If you do not know the color code, you can run the below code to find it!
Sub ColorCode()
Dim Target As Range
Set Target = Application.InputBox("Select desired cell to return color code", Type:=8)
If Not Target.Count > 1 Then
MsgBox "Color Code: " & Target.Interior.Color
End If
End Sub
I'm having problems making copy/pasting clean. Currently I have this:
If distanceValue <= distanceParameter Then
sh2.Rows(i).Copy _
sh3.Rows(i).Offset(0, 1)
End If
sh2 and sh3 are properly defined and it's inside a for loop; that's not the problem. Range seems messy to use, as I would have to define a lastcolumn variable, etc. Is there anyway to do this with .Rows?
The goal is to copy a row if it meets the condition to another sheet but leaving column A blank. Any feedback on clean solutions (I know this one is wrong) would be greatly appreciated.
Your copy range (if you copy the entire row) will be larger then your paste range if you offset by a column. You can't paste 16384 columns into 16383, not enough room.
If you do not wish to use the range function, you will have to copy the entire rows then add a column to the front.
Or you could add the column to the source data before the copy paste, removing the columns when finished if needed.
Sub Sample()
Dim sh2 As Worksheet, sh3 As Worksheet
Set sh2 = Worksheets("Sheet1")
Set sh3 = Worksheets("Sheet2")
If distanceValue <= distanceParameter Then
sh2.Rows(i).Copy _
sh3.Rows(i)
End If
sh3.Columns("A").insert
End Sub
OR
Sub Sample()
Dim sh2 As Worksheet, sh3 As Worksheet
Set sh2 = Worksheets("Sheet1")
Set sh3 = Worksheets("Sheet2")
sh2.Columns("A").insert
If distanceValue <= distanceParameter Then
sh2.Rows(i).Copy _
sh3.Rows(i)
End If
'The next line is to return the source data back to the original format remove if not needed
sh2.Columns("A").Delete
End Sub
Your last option and most dynamic would be to work with a listobject/DataTable instead of an excel range. IF POSSIBLE.
If you have a Table already Then you could simply use :
Sub Sample()
Dim sh2 As Worksheet, sh3 As Worksheet
Dim rngCurrentRow As Range
Set sh2 = Worksheets("Sheet1")
Set sh3 = Worksheets("Sheet2")
Set rngCurrentRow = sh2.ListObjects("YourTableNameHere").ListRows(i).Range
If distanceValue <= distanceParameter Then
rngCurrentRow.Copy _
sh3.Cells(i, 2)
End If
End Sub
Making a Range into a table is Very Easy, If your data does not contain blanks its as easy as clicking on the first cell in your Range and Pressing Ctrl+L This will then select your range, If you need to increase the size of your range because it does contain spaces then simple change the input box to select all your Data.
Don't forget if you have heade3rs to check the check box
NOTE: If you are unsure of your Table name simply click on the table then on the ribbon a new tab will pop up and the end called Table Tools/Design. On that tab the left most area contains your table name, You can change this to anything you'd like.