I am new to vbs and need to know how to search a column for certain criteria then copy any rows matching that criteria to a new spreadsheet. I have several categories of data that I pull all from a single spreadsheet but it requires a lot of 'filter on this column, filter on this column, eyeball for this criteria in another column, if it matches then copy and paste the row to the proper category'. I basically want to take all of this manual effort and automate it.
My second question is when searching in certain columns I have dates in I need to find rows that fit the criteria of '21 days or closer to the current date'. How can I specify the script to look at the dates and copy and paste all rows that are no further out than 21 days from the current date?
Thanks in advance!
There are two ways to automate the manipulation of spreadsheet (Excel?) data: Both start with specifying your tasks in plain/natural language (e.g. 'copy all rows with ??-date 21 days greater/greater equal/smaller/smaller equal than the current date from sheet ?? (row/col?) to sheet ?? (row/col?)' and then
use the macro recorder to get the VBA code to solve the task and 'port' it to VBScript
translate the task decriptions to SQL statements and execute them on an ADO connection to the spreadsheet
Whether the first or the second way is better for you depends on your knowledge and skills.
Are you interested in creating a custom macro using VBS? Adding VB file under Development/Visual Basic, You can process rows and columns.
Sub CountX(pRowStart As Integer, pRowStop As Integer, pColStart As Integer, pColStop As Integer, pObjGrp As String)
Dim x As Integer
Dim xRow As Integer
Dim xCol As Integer
Dim wSht As Worksheet
x = 0
'**** create object reference to worksheet object.
Set wSht = Worksheets("Sheet1")
'**** set cell control values
xRow = 1
xCol = 3
Do While xRow < pRowStop + 1
Do While xCol < pColStop + 1
If UCase(ActiveSheet.Cells(xRow, xCol)) = "X" Then
x = x + 1
End If
xCol = xCol + 1
Loop
xCol = pColStart
xRow = xRow + 1
Loop
End Sub
You can also add this to your code to activate another sheet and set the value to row 1 column 3
Sheets(psSheetName).Activate
ActiveSheet.Cells(1, 3).Value = "value"
Related
I am currently working on a warehouse datasheet and looking to capture information from it. I need help with either a formula or VBA code.
A B C
Row 1 - product - batch number - expiry date
These are 3 columns from multiple within the sheet, however, the focus is on them. I am trying to find a formula or VBA code to allow me to do the following:
The word "cake" used as a product reference.
If a cell within the product column has the value "cake", return the value of the cell from the expiry date column which is on the same row as the initial cell found.
Repeat this process, but skip the previously found cell.
Currently, I tried this formula:
=IF(A:A="Cake",C1,"")
This is what I started with and don't have a clue after it. Whatever I search for in Google I can't adjust it to what I want. I tried Vlookup too.
To me this seems like I need a VBA code that can do that on a loop and return the values automatically for me.
I know my attempt is pathetic, but I've been searching online for 2 days with no progress. Can you suggest something? Thank you
I am expecting to have a separate sheet, from all the input sheets, collecting a list of products, their batch number and the expiry date related to them, to apply conditional formatting to be warned if a batch is due to be expired.
This would be relatively easy to do in VBA:
Sub returnExpirydates()
Dim strInput As String
Dim lngCount As Long, lngRow As Long
Dim wsInput As Worksheet, wsOutput As Worksheet
strInput = InputBox("Please enter the desired product.")
lngCount = 2
lngRow = 2
Set wsInput = Sheets("YourInputSheetName")
Set wsOutput = Sheets("YourOutputSheetName")
wsOutput.Cells.Clear
wsOutput.Rows(1).Value = wsInput.Rows(1).Value
Do While wsInput.Cells(lngCount, 1).Value <> ""
If Cells(lngCount, 1).Value = strInput Then
wsOutput.Rows(lngRow).Value = wsInput.Rows(lngCount).Value
lngRow = lngRow + 1
End If
lngCount = lngCount + 1
Loop
End Sub
This might require a few tweaks to fit your file, let me know if you have follow-up questions.
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).
I have 2 worksheets (WS1 is "ImportWS" and WS2 is "Disco + BLScope", there are names in column A in both worksheets and both have a column B with a value like Jumps high or still cant jump high). I need to compare WS Disco + BLScope column A with ImportWS Column A and if a match is found then copy the adjacent value in WS ImportWS Column "B" to WS Disco + BLScope Column "B" on the respective matched row and then continue to see if there are more updates in WS ImportWSand repeat.
In a perfect-world, a pop up would appear at the end stating how many updates were found/made.
I have tried Vlookups but that doesn't work as I want to keep the value in WS Master if a match is not found.
I found this code (which does the core of what I need) which I tried to adjust but I get a run time error on the "lassrowAdd" line:
Sub CopyAdjacent()
Dim colStatus, lastrowAdd, lastrowRemove As Integer
colStatus = 2
lastrowAdd = Sheets(“ImportWS”).Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrowAdd
If Sheets(“ImportWS”).Cells(i, 1).Value = Sheets(“Disco + BLScope”).Cells(i, 1).Value Then
Sheets(“Disco + BLScope”).Cells(i, colStatus).Value = Sheets(“ImportWS”).Cells(i, colStatus).Value
End If
Next
End Sub
So basically the end result would be:
The worksheet Disco + BLScope would have an updated value in the respective column B rows if an update is found in worksheet ImportWS.
At the end of the macro a popup to appear (this is totally optional) stating how many updates were found/made.
Hope that made sense, been trying for hours but cant crack it, your help would very much be appreciated.
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 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!