I realize that this is probably a duplicate, but I've been searching for an hour and I can't to get the syntax right.
I have a sheet with several tables. There is at least one empty column and one empty row between one table to the other.
I know the start row and start column of each table, and I know that each table has 3 columns. I don't know how many rows it has.
I want to write a sub that receives:
table start row
table start column
and copies the table into another sheet (let's say that the destination is sheet2 starting at A1).
I know I can do it with a loop, but I suspect there is a better syntax right?
(The main issue here is that I need to find the number of rows each table has)
Thanks.
Li
This sub will do the job:
Sub CopyTable(wsSource As Worksheet, lngTopRow As Long, intLeftCol As Integer, rngTarget As Range)
Dim rngSource As Range
Dim intCols As Integer, lngRows As Long
Set rngSource = wsSource.Cells(lngTopRow, intLeftCol)
intCols = rngSource.End(xlToRight).Column - intLeftCol + 1
lngRows = wsSource.Cells(wsSource.Rows.Count, intLeftCol).End(xlUp).Row - lngTopRow + 1
rngSource.Resize(lngRows, intCols).Copy rngTarget
End Sub
To copy a table starting in rows 1, column 5 of worksheet1 to Sheet2!A2, use the following call:
CopyTable Sheets("Sheet1"), 1, 5, Sheets("Sheet2").Range("A2")
This assumes that there's nothing below each table. If that is not the case, replace the 3rd instruction with
lngRows = rngSource.End(xlDown).Row - lngTopRow + 1
This will now assume, that the first column of your table has no gaps. If this is not true, try using rngSource.UsedRange.Row instead of rngSource.End(xlDown).Row!
Related
I am new to vba and having a little trouble figuring this out. Don't really know where to start
I have two tables. I'm simply just trying to find code to say that if the last row in table 1 of worksheet 1 has any value in the 2nd column and the value in the last column is greater than 1 then take the value in the last column of the last row and add that many rows to table 2 of worksheet 2.
I tried searching other posts for this same type of topic but couldn't find any. Any help would be greatly appreciated.
Try adding this to a standard module
You could validate if the last column last row value is a number. I'm assuming that it is.
Code:
Public Sub AddRowsToTable()
Dim sourceTable As ListObject
Dim targetTable As ListObject
Set sourceTable = Range("Table1").ListObject
Set targetTable = Range("Table2").ListObject
Dim valueSecondCol As Variant
Dim valueLastRowLastCol As Long
' Get last row, second column value
valueSecondCol = sourceTable.ListColumns(2).DataBodyRange.Cells(sourceTable.ListRows.Count).Value
' Get last row, last column value
valueLastRowLastCol = sourceTable.ListColumns(sourceTable.ListColumns.Count).DataBodyRange.Cells(sourceTable.ListRows.Count).Value
' Exit if it's null
If valueSecondCol = vbNullString Then Exit Sub
' Add as many rows as the number in last column, last row of source table to target table
targetTable.Resize targetTable.HeaderRowRange.Resize(targetTable.ListRows.Count + valueLastRowLastCol + 1)
End Sub
Let me know if it works.
So im currently working a table in excel that I have named Table1 with three columns (Column 1, Column 2 and Column 3). Ive been trying to count the used rows or populated rows inside the table using VBA but have had no luck.
Example 1:
UsedRows= Sheets ("Sheet1").ListObjects.("Table1[#Column 1]").UsedRange.ListRows.Count
Example 2 (This One Returns only all available rows)
UsedRows= Sheets ("Sheet1").ListObjects.("Table1[#Column 1]").ListRows.Count
I either want the populated or unpolulated row amount. Either of the two will work just fine. Remember this is a Table so End(xlUp) and End(xlDown) work a little bit different. Ive tried those too but I still get either the total rows available or the cells that are modified which is way more than what I have available.
Thanks for the help in adavanced whoever posts.
Sounds like you can use CountA, like this perhaps:
Dim myColumn As ListColumn
Set myColumn = Sheets("Sheet1").ListObjects("Table1").ListColumns("Column 1")
Dim UsedRows As Long
UsedRows = Application.CountA(myColumn.DataBodyRange)
Debug.Print UsedRows
If you don't have blank cells in other rows. The 3 doesn't need to be hard-coded, this is just the number of columns in your table.
Sub x()
Dim r As Range
Set r = ActiveSheet.ListObjects(1).DataBodyRange
With WorksheetFunction
MsgBox .CountBlank(r) / 3 'empty rows
MsgBox (r.Rows.Count - .CountBlank(r) / 3) 'non-empty rows
End With
End Sub
Worksheet1:
Excel sheet
New
Worksheet 1 has licences with 6 columns of information - two being the start and end date.
I need a method of extracting all the records that are within 90 days before the expiry date- the idea being I want a separate alert page
I have done a IF statement that is on the end of the columns that just prints 1 if date is hits the alert criteria or 0 if not...The idea now in Worksheet2 I need some sort of VLOOKUP and IF to extract those records automatically.
How would I do this?
=IF(IFERROR(DATEDIF(TODAY(),H5,"d"),91)<90,1,0)
While use of Pivot table or VBA macro is recommended in such cases, if you absolutely need to use the formula then you may use the below trick.
You already have the Binary column. Now, add another column say Cumulative Binary that will sum all the 1's till the current row using a SumIf formula as shown in the screenshot below (it is fine if some numbers are repeated because of 0's)
The formula in I3 in my workbook is
=SUMIF(H$3:H3,1,H$3:H3)
and you may adjust it as per your needs.
Now, it is easy since each row has a unique number, we could use Vlookup or like I have done here i.e. use Offset function which simply matches the value in the "Lookup Column" to the value in "Cumulative Binary" column and returns the rows that match.
=IFERROR(OFFSET($F$2,MATCH(M3,$I$3:$I$9,0),0,1,2),"")
Please note that it is an array formula as I need to return multiple columns (2 here). So, I selected two columns N,O as shown in the screenshot wrote the formula and used Ctrl+Shift+Enter (instead of Enter). Then I simply dragged the formula down. You may want to adjust it as per your needs by including more columns.
If you can use VBA, you may write some code like this:
Option Explicit
Public Sub CopyCloseToExpiration()
Dim rngSource As Range: Set rngSource = ThisWorkbook.Worksheets("Sheet1").Cells(2, 1).Resize(LastRow(ThisWorkbook.Worksheets("Sheet1")) - 1, 9)
Dim rngDestinationTopLeft As Range: Set rngDestinationTopLeft = ThisWorkbook.Worksheets("Sheet2").Cells(LastRow(ThisWorkbook.Worksheets("Sheet2")) + 1, 1)
Dim datLimit As Date: datLimit = DateAdd("d", 90, Date)
CopyBeforeDate rngSource, rngDestinationTopLeft, datLimit
End Sub
Public Sub CopyBeforeDate(rngSource As Range, rngDestinationTopLeft As Range, datLimit As Date)
Dim lngOffset As Long: lngOffset = 0
Dim rngRow As Range: For Each rngRow In rngSource.Rows
If rngRow.Cells(1, 8).Value < datLimit Then
rngDestinationTopLeft.offset(lngOffset, 0).Resize(rngRow.Rows.Count, rngRow.Columns.Count).Value = rngRow.Value
lngOffset = lngOffset + 1
End If
Next
End Sub
Public Function LastRow(ewsSheet) As Long
With ewsSheet
Dim lngResult As Long: lngResult = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
LastRow = lngResult
End Function
You have to put the above into a new Module, customize it (e.g. replace "Sheet1" with the name of you worksheet's actual name), and run it (You can place the caret on the sub CopyCloseToExpiration and hit F5 or place a button somewhere and call this function from its event handler).
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.
I have two tables. One of them has server names. The other has timestamps (first table, column A below) and text strings (first table, column B below). I want to search those strings for a keywords specified in the server table (second table below). If the match is found function writes to the cell name from the header of the column where the keyword is.
Example
I want to complete column System in Blue table. So for example C2 should show GreenSys and C8 - RedSys.
I have tried using SEARCH function but it looks like it tries to match whole table to the string if I pass it as an argument. VLOOKUP doesnt work too as I am using two tables. What's the best way for me to get this working?
If you change the way you have the data setup so that it is a bit more Excel-friendly, this can be rather easily accomplished.
The lookup sheet should look like this (the formula below has this as 'Sheet2'):
Then on your main data sheet, in cell C2 and copied down:
=IF(SUMPRODUCT(COUNTIF(B2,"*"&Sheet2!$A$2:$A$7&"*")),INDEX(Sheet2!B:B,SUMPRODUCT(COUNTIF(B2,"*"&Sheet2!$A$2:$A$7&"*")*ROW(Sheet2!$A$2:$A$7))),"")
The results look like this:
With the assumption that all Servers start with "Serv".. this should work without using vba.
=MID(B1,SEARCH("Serv",B1,1),IF(ISERROR(SEARCH(" ",B1,SEARCH("Serv",B1,1))),LEN(B1)-SEARCH("Serv",B1,1),SEARCH(" ",B1,SEARCH("Serv",B1,1))-SEARCH("Serv",B1,1)))
Essentially the formulas searches for the keyword serv and then attempts to parse until the end of the word to return the full name.
As someone else mentioned, it would be easier to do with vba but then again there is a benefit of not having macros.
Can you try this formula to cellC2?
=IF(SUMPRODUCT((B2=Sheet2!$A$2:$D$4)*COLUMN(Sheet2!$A$1:$D$1))>0,
INDEX(Sheet2!$A$1:$D$1,SUMPRODUCT((B2=Sheet2!$A$2:$D$4)*COLUMN(Sheet2!$A$1:$D$1)))
,"")
I have assumed that the second table is at Sheet2 and that data is upto column D, starting with the headers at A1, with the format you describe.
EDIT:
I can see you have amended the original post, and my answer no longer meets the specifications. Therefore I think it is best that I delete it.
EDIT2:
Added VBA solution. Assumptions:
Orignal data table in Sheet1
Destination table in Sheet2
Headers of Sheet1 in 1st row
The below code was tested, it should be OK but needs error handling:
Sub moveData()
Dim rngDestination As Range
Dim lRowCounter As Long, lColCounter As Long, lValueCounter As Long, lLastRow As Long
Dim vOriginArray As Variant, vValuesArray As Variant, vDestinationArray As Variant
' Database table in Sheet2
vOriginArray = Sheet2.UsedRange.Value
' Destination table in Sheet1
With Sheet1
lLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
' Put the values we need to compare into an array
vValuesArray = .Range(.Cells(2, 2), .Cells(lLastRow, 2)).Value
Set rngDestination = .Range(.Cells(2, 3), .Cells(lLastRow, 3))
End With
' We will store the values to an array first and then
' back to the sheet, it is faster this way
ReDim vDestinationArray(1 To rngDestination.Rows.Count, 1 To 1)
' Loop through all rows and columns, exclude header row
For lRowCounter = 2 To UBound(vOriginArray, 1)
For lColCounter = LBound(vOriginArray, 2) To UBound(vOriginArray, 2)
' For each entry, find which values match and store them
For lValueCounter = 1 To UBound(vValuesArray, 1)
If InStr(1, vValuesArray(lValueCounter, 1), vOriginArray(lRowCounter, lColCounter), vbTextCompare) Then
vDestinationArray(lValueCounter, 1) = vOriginArray(1, lColCounter)
End If
Next lValueCounter
Next lColCounter
Next lRowCounter
' Put the data back to excel
With rngDestination
.ClearContents
.Value = vDestinationArray
End With
End Sub