I am trying to create a Stacked Column Chart with the data in the table below.
I want to Select column A1:A9 and C1:F9. The Selection also needs to be adaptive to different column sizes (i.e, someone adds another Feature). The macro should also work for a table of data, anywhere in the Sheet. As long as the macro originates from the ActiveCell.
How do I not only Select until the column end, but also Select excluding the "Values" column. I am trying to use End and Offset, but I am not sure the best way to do it. And once again, I want to use it on a table that is anywhere in the sheet and then create a Stacked Column Chart from it.
Thanks for your help!
Try this code please. The idea is that you iteratively Union various ranges of the data based on the condition that the header is not 'Values'.
The working assumption is that the CurrentRegion of the ActiveCell will select your table data. Where the definition of CurrentRegion is 'The current region is a range bounded by any combination of blank rows and blank columns. ' - MSDN link
Then the code will append the first column to an output range. After that, the outer columns will only be appended to the output range if the header is not 'Values'.
Dim rngData As Range
Dim intCounter As Integer
Dim rngToSelect As Range
Set rngData = ActiveCell.CurrentRegion
Set rngToSelect = Range(rngData.Cells(1, 1), rngData.Cells(rngData.Rows.Count, 1))
For intCounter = 1 To rngData.Columns.Count
If rngData.Cells(1, intCounter).Value <> "Values" Then
Set rngToSelect = Union(rngToSelect, Range(rngData.Cells(1, intCounter), rngData.Cells(rngData.Rows.Count, intCounter)))
End If
Next intCounter
rngToSelect.Select
Related
I have a table named table in a worksheet titled Sheet. I want to get a range consisting of the a specified column of the body of the table. The following code works:
Public Function GetColumn(colNum as Integer) As Range
With Sheet.ListObjects("table").DataBodyRange
Set GetColumn = Range(.Cells(1, colNum), .Cells(.Rows.Count, colNum))
End With
End Function
I feel there must be a more elegant way to solve this problem.
It seemed like the Columns property would be the way to go but I can't seem to get the syntax right.
You can use the Columns-property of a range to get the range for one column of that range simply by specifying the column number. Note that the index is always relative, if your range starts at C3, column(2) would refer to column D of the sheet.
So for you case:
Including the header cell:
Set GetColumn = ws.ListObjects("Table").Range.Columns(colNum)
Without header cell:
Set GetColumn = ws.ListObjects("Table").DataBodyRange.Columns(colNum)
Update: When you access a Range like that and iterate over it with foreach, it will only execute one iteration, containing all cells. Fix is easy:
Set GetColumn = ws.ListObjects("Table").DataBodyRange.Columns(colNum).Cells
I'm new to using VBA and need to copy data from a range of cells on one worksheet to another worksheet. I need to copy a column of cells and paste it into a row of cells e.g. A1:A4 to A1:D1. This is the code i'm using but it doesn't work the way i need it too.
Sub Draft()
Worksheets("Material Check").Range("B3:B6").Copy _
Destination:=Worksheets("Archive").Range("A2:D2")
End Sub
Also I need the data thats being copied over to be added to the bottom of the table on the archive sheets and i'm not sure how to do this.
Without Excel Tables
This is a bit of an odd way to do it but if you have a lot of cells to do, it's possibly faster than copy/paste special:
ThisWorkbook.Worksheets("Archive").Range("A2:D2").Formula = "=INDEX('Material Check'!$B$3:$B$6,Column())"
ThisWorkbook.Worksheets("Archive").Range("A2:D2").Value = ThisWorkbook.Worksheets("Archive").Range("A2:D2").Value
The first line populates the destination range with a formula that pulls the data from the source, using INDEX/COLUMN to transpose the result.
The second line simply converts the formula to hard values.
EDIT - Solution to copy the values to the bottom of the list
Using Excel Table
To do this you will need to go to "Insert" --> "Table".
''Get a reference to your destination table
Dim Tbl1 As ListObject
Set Tbl1 = ThisWorkbook.Sheets("Archive").ListObjects("Table1") ''Change these to your destination sheet/table names
''add a new row to the table
Dim Newrow As ListRow
Set Newrow = Tbl1.ListRows.Add
''populate the new row
With Newrow
.Range(Tbl1.ListColumns("Column1").Index) = ThisWorkbook.Worksheets("Material Check").Range("B3") ''change these to your destination column name and your source sheet/ranges
.Range(Tbl1.ListColumns("Column2").Index) = ThisWorkbook.Worksheets("Material Check").Range("B4")
.Range(Tbl1.ListColumns("Column3").Index) = ThisWorkbook.Worksheets("Material Check").Range("B5")
.Range(Tbl1.ListColumns("Column4").Index) = ThisWorkbook.Worksheets("Material Check").Range("B6")
End With
I have a pivot table with data, I need to copy and past all of the data except for the last row, which I need to delete as it is a sum of totals. The amount of data entries vary by week so I cannot just put the set numbers in. Currently my code looks like this;
Worksheets("Mobile Summary").Range("A4:F482").Copy
Worksheets("Sheet1").Range("A1:F479")
However I need to copy and paste more data from a different pivot table directly under this. Therefore I couldn't just set the rows to 3000 for example. I know there is a code to find the last row, although I'm coming up short as to how to go about solving this problem.
To find a pivot table by its name and remove the last row of the table use the Range.Resize property. This is useful if there is more than one pivot table on a worksheet.
Option Explicit
Sub CopyPivotTableWithoutLastRow()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Tabelle3")
Dim i As Long
For i = 1 To ws.PivotTables.Count 'loop throug all pivot tables
If ws.PivotTables(i).name = "PivotTable1" Then 'determine pivot table by its name
With ws.PivotTables(i).TableRange1 '= full table
.Resize(RowSize:=.Rows.Count - 1).Copy 'resize to remove last row then copy
End With
End If
Next i
End Sub
Currently I have a medical spread-sheet with a list of clients that we have serviced. We have 8 different clinical categories which are denoted by different acronyms - HV,SV,CV,WV,CC,OV,TS and GS.
A client can receive multiple therapies i.e. HV,SV,CV - in the background we have a counter mechanism which would increment each of these records by 1.The formula used for this counter is:
=(LEN('Parent Sheet'!F25)-LEN(SUBSTITUTE('Parent Sheet'!F25,'Parent Sheet'!$P$4,"")))/LEN('Parent Sheet'!$P$4)
At the bottom of the sheet we then have a sum which ads up all the treatments that occurred for that week.
Now the tricky part about this is that we have almost a year's worth of data in this sheet but the summing formulas are set as: SUM(COLUMN 6: COLUMN 53) but due to a need to increase the entries beyond this limit, we have to adjust the sum formula. We have 300 SUM Formulas adding up each of the 8 Criteria items and assigning them to the HV,SV,SC,WV etc. counters.
Would we have to adjust this manually one by one or is there a easier way of doing this?
Thank you very much!
To me, I think you should change the sheet layout a little, create a User Defined Function (UDF) and alter the formulas in your Sum rows for efficient row/column adding (to make use of Excel's formula fill). The only issue is that you need to save this as a Macro-Enabled file.
What you need to change in the formulas is to utilize $ to restrict changes in column and rows when the formula fill takes place.
To illustrate in an example, consider:
Assuming the first data starts at row 6, and no more than row 15 (you can use the idea of another data gap on the top). Alter the Sum row titles to begin with the abbreviation then create a UDF like below:
Option Explicit
' The oRngType refers to a cell where the abbreviation is stored
' The oRngCount refers to cells that the abbreviation is to be counted
' Say "HV" is stored in $C16, and the cells to count for HV is D$6:D$15,
' then the sum of HV for that date (D16) is calculated by formula
' `=CountType($C16, D$6:D$15)`
Function CountType(ByRef oRngType As Range, ByRef oRngCount) As Long
Dim oRngVal As Variant, oVal As Variant, oTmp As Variant, sLookFor As String, count As Long
sLookFor = Left(oRngType.Value, 2)
oRngVal = oRngCount.Value ' Load all the values onto memory
count = 0
For Each oVal In oRngVal
If Not IsEmpty(oVal) Then
For Each oTmp In Split(oVal, ",")
If InStr(1, oTmp, sLookFor, vbTextCompare) > 0 Then count = count + 1
Next
End If
Next
CountType = count
End Function
Formulas in the sheet:
Columns to sum are fixed to rows 6 to 15 and Type to lookup is fixed to Column C
D16 | =CountType($C16,D$6:D$15)
D17 | =CountType($C17,D$6:D$15)
...
E16 | =CountType($C16,E$6:E$15)
E17 | =CountType($C17,E$6:E$15)
The way I created the UDF is to lookup and count appearances of a cell value (first argument) within a range of cells (second argument). So you can use it to count a type of treatment for a big range of cells (column G).
Now if you add many columns after F, you just need to use the AutoFill and the appropriate rows and columns will be there.
You can also create another VBA Sub to add rows and columns and formulas for you, but that's a different question.
It's isn't a great idea to have 300 sum formulas.
Name your data range and include that inside the SUM formula. So each time the NAMED data range expands, the sum gets calculated based on that. Here's how to create a dynamic named rnage.
Sorry I just saw your comment. Following is a simple/crude VBA snippet.
Range("B3:F12") is rangeValue; Range("C18") is rngTotal.
Option Explicit
Sub SumAll()
Dim WS As Worksheet
Dim rngSum As Range
Dim rngData As Range
Dim rowCount As Integer
Dim colCount As Integer
Dim i As Integer
Dim varSum As Variant
'assuming that your said mechanism increases the data range by 1 row
Set WS = ThisWorkbook.Sheets("Sheet2")
Set rngData = WS.Range("valueRange")
Set rngSum = WS.Range("rngTotal")
colCount = rngData.Columns.Count
'to take the newly added row (by your internal mechanism) into consideration
rowCount = rngData.Rows.Count + 1
ReDim varSum(0 To colCount)
For i = 0 To UBound(varSum, 1)
varSum(i) = Application.Sum(rngData.Resize(rowCount, 1).Offset(, i))
Next i
'transpose variant array with totals to sheet range
rngSum.Resize(colCount, 1).Value = Application.Transpose(varSum)
'release objects in the memory
Set rngSum = Nothing
Set rngData = Nothing
Set WS = Nothing
Set varSum = Nothing
End Sub
Screen:
You can use named ranges as suggested by bonCodigo or you could use find and replace or you can insert the columns within the data range and Excel will update the formula for you automatically.
It seems that applying filter to a table has destroyed my understanding of how to handle this.
I have a table with multiple columns. I'm going to filter on one of the columns and sort on another. After that, I want to select/copy the first 10 rows of specific columns of what's filtered into another table.
I could easily do this before filters. I need the first 10 rows AFTER the filter is applied. I'm not seeing how to choose the 10th row AFTER a filter.
Can anyone point me to a VBA reference that explains how to do this? Do I need to use SQL to do this? Am I over thinking this and making it too complicated?
The following works to select the first 10 visible cells of column F, after filtering is applied. You'll need start at F2 if you want to exclude the header-cell.
Sub TenVisible()
Dim rng As Range
Dim rngF As Range
Dim rng10 As Range
Set rngF = Range("F:F").SpecialCells(xlCellTypeVisible)
For Each rng In Range("F:F")
If Not Intersect(rng, rngF) Is Nothing Then
If rng10 Is Nothing Then
Set rng10 = rng
Else
Set rng10 = Union(rng10, rng)
End If
If rng10.Cells.Count = 10 Then Exit For
End If
Next rng
Debug.Print rng10.Address
'.. $F$1:$F$2,$F$4:$F$5,$F$9:$F$10,$F$12,$F$20:$F$21,$F$23
rng10.Select
End Sub
The following is one of a number of ways to select from F2 downwards (assuming the UsedRange starts from row 1):
Set rngF = Range("F2", Cells(ActiveSheet.UsedRange.Rows.Count, _
Range("F2").Column)).SpecialCells(xlCellTypeVisible)
For what it's worth, seeing as this is one of the first search results for this kind of issue -
after filtering a table on a named column like this :
Worksheets("YourDataSheet").ListObjects("Table_Name").Range.AutoFilter _
field:=Worksheets("YourDataSheet").ListObjects("Table_Name").ListColumns("ColumnName").Index, _
Criteria1:="FilterFor..."
... I was then able to copy the resulting single visible row to another sheet using :
Worksheets("YourDataSheet").Range("Table_Name").SpecialCells(xlCellTypeVisible).Range("A1").EntireRow.Copy _
Destination:=Range("AnotherSheet!$A$2").EntireRow
So that's one way to refer to visible rows after the filtering. HTH.