I am having two Sheets BW and PSW.
With the BW the data is starting from row 4. the above 3 rows are merged and I have some command Buttons there. the sheet PSW starts from 1st row.
I am looking for the ID in sheet1,which starts from L5 and when the Id matches in sheet2, it pulls the date from sheet2 to sheet1.
I am using the below code. The code, is not executing any Output. Could anyone tell where I am making mistake.
I suppose,in the below line, the range starts from A and since my data starts from row5, it does not Count. if this is the case, then how i should Change the range. I had this code running, if my data starts with row1 without any command buttons.
totalrows = Sheets("BW").Cells(Rows.Count, "A").End(xlUp).Row
Sub lookupePSR()
Dim totalrows As Long, totalrowsSht2 As Long
totalrows = Sheets("PSW").Cells(Rows.Count, "A").End(xlUp).Row
totalrowsSht2 = Sheets("PSW").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("PSW").Range("AA5:AA" & totalrows).Formula = Application.WorksheetFunction.IfError(Application.VLookup(Sheets("PSW").Range("L5:L" & totalrowsSht2), Sheets("PSW").Range("$A:$L"), 7, 0), "")
End Sub
As mentioned in comments, put the actual formula into the worksheet; optionally revert to the values returned by the formulas.
with Sheets("PSW").Range("AA5:AA" & totalrows)
.Formula = "=iferror(vlookup(l5, $a:$g, 7, false), text(,))"
'optionally revert the formulas' returned values to values in cells
.value = .value
end with
The TEXT(,) is the same as ""; i.e. a zero-length string. I use this because you have to double-up double-quotes (e.g. "" becomes """") when used in a quoted string like the formula above and that confuses matters.
I've cut your lookup range down to A:G since you are only looking for the seventh column in the range.
Related
VBA question using Excel 2016 (64 bit)
I have header data in the first two columns (A:B) and the top row (1). I would like to dynamically paste a formula downward, starting from cell C2, to the last row and the last column. The working prototype is as follows:
Dim LstCol As Long
LstCol = Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, "C"), Cells(2, LstCol)).Value = "=INDEX(RC1,MATCH(R1C,RC2,0))"
Dim LstRow As Long
LstRow = Cells(1, Rows.Count).End(xlUp).Row
Range(Cells(2, "C"), Cells(2, LstRow)).Value = "=INDEX(RC1,MATCH(RC1,R2C,0))"
The first Dim works as intended. The formula is successfully deployed throughout the second row to the final column (or perhaps it starts at the last column and moves leftward). However, the second Dim stops on an error. I'm unsure how to spread the data from the last row (to the last column) upwards to the second row (and the corresponding last column).
In my example, the first two columns have header data from 1 to 5330 (A1:B5330). I also have header data in the first row (C1:AX1). My target is to fill the formula =INDEX($A2,MATCH(D$1,$B2,0)) from C2:AX5330 dynamically.
Where am I going wrong?
You need to properly qualify your instances of Range and Cells with a worksheet. You can either directly do this, dim a worksheet variable, or use a With block like so:
Dim LRow as Long
With ThisworkBook.Sheets("????")
LRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("C2:AX5330").Formula = "=INDEX($A2,MATCH(D$1,$B2,0))" 'Make sure your cell references are correct here
.Range("C2:AX5330").Value = .Range("C2:AX55330").Value 'Place as values instead of formula
End With
Sub Link()
Dim Turbidity As Long
Dim RawTurbidity As Range
'Sets variables Turbidity being the ActiveCell and RawTurbidity referring to the last captured cell in raw sheets'
Turbidity = ActiveCell.Row
Set RawTurbidity = Sheets("Raw Data").Range("C4").End(xlDown)
'The formula assigning the last captured cell in Raw sheets to the active cell '
Sheet1.Range(Sheet1.Cells(Turbidity, 4), Sheet1.Cells(Turbidity, 4)).Formula = RawTurbidity
End Sub
So this is the code I have and currently it does what it's suppose to do. We have two sheets atm sheet1 and Raw Data An instrument spits out data into column C of Raw data starting wtih C4 and going all the way down. The current code I wrote in essence paste the newest value the instrument spits out to the active cell in sheet1. I have a code on Raw Data that runs the macro only when a change is made to column C4 and lower. And it works exactly how I want it to however...
my question or issue is that when I add activecell.offset(1,0).select in order to have the activecell automatically go to the next row in sheet1 without me moving the mouse the macro copies and paste the same data into the next 4 cells. If I have the intrument spit out the data again than this time it occupies the next 6 rows with the same data.
Joe B, I think you are making this harder than it is.
Last value in a sheet column gets copied to the next open row in a specified column on another sheet? Is that right?
Option Explicit
Sub Link()
Dim ws1 As Worksheet
Dim wsRaw As Worksheet
Dim ws1LastRow As Long ' "Turbidity"
Dim wsRawLastRow As Long ' "RawTurbidity"
' I suggest you just name the sheets using the developer prop window
'It cuts this whole part out as you can call them directly
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 'lets say you are pasting to column A
'ws1LastRow = ws1LastRow + 1
'There you go the next writable cell row, this is wasted code though, see below you just increment when you need it
wsRawLastRow = wsRaw.Cells(wsRaw.Rows.Count, "C").End(xlUp).Row 'This method doesn't care if your data starts in C4
'No formula needed, it is a straight "copy" here, actually faster as its an assignment
ws1.Cells(ws1LastRow + 1, "A").Value = wsRaw.Cells(wsRawLastRow, "C").Value
'the next open cell (defined by row) in your sheet 1 column is equal to the last row of your Raw Data sheet column
End Sub
Issue is that the data in sheet one is not inputted in order. A person may need the data calculated to row 10 and the next calculation needs to be in row 20 hence the need to copy the data into the active cell.
This was my bad for not stating that in the initial post as it's the primary reason for this strange formula.
I am dealing with a sheet of data that has multiple rows ans columns. Each time the macro runs, the number of rows can be different, so I am trying to find the last row for a column.
With the last row, I am trying to do a calculation. For example: if the row I get is 1200, I can do A1200/A2-1. MY code should explicitly paste the formula in an output worksheet and currently (currently I have to put the last row myself).
Question: How can I get the last row and put it in a formula? Should I assign it to a variable and then use the variable in the formula?
Lines of code I am using:
Sub Output()
Dim LastRowA As Long
LastRowA = Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
'this is my current method, it works using specific cells.
'I would like to change the D1662, for example, for a floating reference that gets the last row
Worksheets("Sheet2").Range("C2:C2").Formula = "='TIME SERIES'!D1662/'TIME SERIES'!D2-1"
End Sub
Like so. Just remove the variable from the quotes.
Sub Output()
Dim LastRowA As Long
LastRowA = Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
'this is my current method, it works using specific cells.
'I would like to change the D1662, for example, for a floating reference that gets the last row
Worksheets("Sheet2").Range("C2:C2").Formula = "='TIME SERIES'!D" & LastRowA & "/'TIME SERIES'!D2-1"
End Sub
How about a user defined function? This way you can add it to your equation in excel with =LastRow(ColumnNumber). You can leave this in the vba editor and in excel set you cell value to "=LastRowValue("SheetName",1)/A2-1" where 1 would be column A.
Function LastRowValue(WorksheetName As String, Col As Long) As Long
'=======================================================================
'This can be typed into an excel cell as a normal function
'"=LastRow("SheetName",ColumnNumber)" The Column Number is indexed
'starting with A=1 so C=3 and AA=27. Enter the WorksheetName in
'quotes "WorksheetName".
'========================================================================
Dim LR As Long
'LR will find the last row in column number "col" in WorksheetName.
LR = ThisWorkbook.Sheets(WorksheetName).Cells(Rows.Count, Col).End(xlUp).Row
'LastRowValue will be the output of this function and will be the value of
'the last row in WorksheetName.
LastRowValue = Cells(LR, Col).Value
End Function
I am new to Excel Macros and VBA, and am facing the following problem:
(1) I have a data-set which has ~50,000 rows and 11 columns.
(2) I need to extract rows from the sheet, based on a certain keyword - which matches the strings present in a particular column.
(3) I have the following code from another stack overflow question:
Sub testIt()
Dim r As Long, endRow as Long, pasteRowIndex As Long
endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
End Sub
(4) This works perfectly fine when the cell of the column being searched has "YourCriteria" as the only entry.
(5) However, in my data I have strings which have the "YourCriteria" embedded in them
For Example: "YourCriteria" = "ball" and the cell(s) in a particular column contain "the dog plays with the ball" , "the ball is bad" etc.
How can I extract the rows containing 'YourCriteria" ? What modification to the code is needed ?
Thanks
To expand on Doug's answer,
If InStr(Cells(r, 2).Value, "YourCriteria")>0 Then 'Found
' ^ Column A=1, B=2, ...
Edit Change 2 to whatever column number you want to look in (C=3, D=4, ...). You can also use Columns("B").Column like you had it, if you're more comfortable with that.
I have found If InStr()>0 to be more reliable than If Instr() since InStr has lots of return-value options.
A general thought, to avoid future problems - rather than switching sheets, refer expressly to which sheet you mean. Example (not all code shown):
dim shSource as Sheet
set shSource = ActiveWorkbook.Sheets("Sheet1")
dim shDest as Sheet
set shDest = ActiveWorkbook.Sheets("Sheet2")
...
If InStr(shSource.Cells(r, 2).Value, "YourCriteria")>0 Then 'Found
shSource.Rows(r).Copy
shDest.Rows(pasteRowIndex).Select
shDest.Paste
There's a built in operator for this in VBA: Like. You can just replace the current test with this:
If Cells(r, Columns("B").Column).Value Like "*YourCriteria*" Then 'Found
InStr( [start], string, substring, [compare] )
Parameters or Arguments
start
Optional. It is the starting position for the search. If this parameter is omitted, the search will begin at position 1.
string
The string to search within.
substring
The substring that you want to find.
compare Optional. It is the type of comparison to perform. It can be one of the following values:
VBA Constant Value Explanation
vbUseCompareOption -1 Uses option compare
vbBinaryCompare 0 Binary comparison
vbTextCompare 1 Textual comparison
borrowed from http://www.techonthenet.com/excel/formulas/instr.php
The fastest way is to:
Apply a Filter to the data
Set a range variable = .SpecialCells(xlCellTypeVisible)
Use range.Copy Sheets("Sheet2").Range("A1") to copy the data straight to Sheet2
Sub DoIt()
Dim SearchRange As Range
Sheets("Sheet1").UsedRange.AutoFilter Field:=2, Criteria1:="=*Ball*", _
Operator:=xlAnd
Set SearchRange = Sheets("Sheet1").UsedRange.SpecialCells(xlCellTypeVisible)
If Not SearchRange Is Nothing Then
SearchRange.Copy Sheets("Sheet2").Range("A1")
End If
End Sub
I recently posted a question, and unfortunately did not get very far with any answers. I have re-worked my macro to mirror a similar scenario I found elsewhere. The problem is I am now getting stuck at the very end.
Purpose of the macro:
1. Beneath the selected cell, I need to insert x new rows = entered months -1
In the first inserted row, I need a set of relative formulas that can be found in the Actual Row 2 of the current worksheet (basically copy and paste row 2 into the first row created)
In the subsequent inserted rows, I need a set of relative formulas that can be found in the Actual Row 3 of the current worksheet
As is, the macro does what I want, except I don't know how to paste row 3 in all subsequent rows. I'm assuming I need some conditional statement?
As mentioned in my last post, I am trying to teach myself VBA, so any help would be appreciated!!
Sub InsertMonthsAndFillFormulas(Optional vRows As Long = 0)
Dim x As Long
ActiveCell.EntireRow.Select 'So you do not have to preselect entire row
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"Enter the total number of months in the program", Title:="Add Months", _
Default:=1, Type:=1) 'Default for 1 row, type 1 is number
If vRows = False Then Exit Sub
End If
Dim sht As Worksheet, shts() As String, i As Long
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedSheets
Sheets(sht.Name).Select
i = i + 1
shts(i) = sht.Name
x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup
Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
Resize(rowsize:=vRows - 1).Insert Shift:=xlDown
Rows(2).EntireRow.Copy Destination:=Selection.Offset(1).Resize( _
rowsize:=1)
Rows(3).EntireRow.Copy Destination:=Selection.Offset(2).Resize( _
rowsize:=1)
On Error Resume Next
Next sht
Worksheets(shts).Select
End Sub
Ok, based on your comments, the below code should meet your needs. But first, a few things to note.
I've added several comments to help you understand what is happening in the code.
Based on your comment regarding vRows, the code will now terminate if the user keeps the default input box value ("1"). The logic is that if the value is only one, then no rows need to be added. Notice that I subtract 1 from the Inputbox value.
The code assumes you have headers or at least filled cells in row one. I use row one to find the last used column.
If there's any chance that the wrong sheet can be active when this code is executed, uncomment line 16 of my code. (Obviously you'd need to change the code to reflect your sheet's name.
Finally, this code assumes that the upper-left corner of your dataset is in A1.
Tested on Sample Dataset
Sub InsertMonthsAndFillFormulas(Optional vRows As Long = 0)
Dim lastCol As Long
Dim r As Range
'Ask user for number of months.
'If the user keeps the default value (1), exit sub.
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"Enter the total number of months in the program", Title:="Add Months", _
Default:=1, Type:=1) - 1
If vRows = 0 Then Exit Sub
End If
'Uncomment this line if you are concerned with which sheet needs to be active.
'ThisWorkbook.Sheets("YourSheet").Select
With ActiveSheet
'Set the range to work with as the cell below the active cell.
Set r = ActiveCell.Offset(1)
'Find the last used column. (Assumes row one contains headers)
'Commented this out to hard-code the last column.
'lastCol = .Rows("1:1").Find("*", searchdirection:=xlPrevious).Column
'Insert the new rows.
r.EntireRow.Resize(vRows).Insert Shift:=xlDown
'r needs to be reset since the new rows pushed it down.
'This time we set r to be the first blank row that will be filled with formulas.
Set r = .Range(.Cells(ActiveCell.Offset(1).Row, 1), _
.Cells(ActiveCell.Offset(1).Row, "H")) '<~~ Replaced lastCol with "H"
'**Add formulas to the new rows.**
'Adds row two formulas to the first blank row.
.Range(.Cells(2, 1), .Cells(2, "H")).Copy r
'Adds row three formulas to the rest of the blank rows.
.Range(.Cells(3, 1), .Cells(3, "H")).Copy r.Offset(1).Resize(vRows - 1)
End With
End Sub
Edit
The variable lastCol is what defines the right most column to copy formulas from. This variable is set using column headers in row 1. I prefer using variables like this to make the code more robust (i.e. you can add a column to your dataset without breaking the macro), however, for this to work you need headers above every used column (or at least cells that contain values).
If you aren't concerned with adding more columns in the furture, you can hard-code the last column into the code (see my revisions).