Excel: How to copy a row if it contains certain text to another worksheet (VBA) - vba

I'm looking to use a marco that would be able to search a column in said sheet and if certain text is found - in my case the word "FAIL" - copy that entire rows data/formatting and paste it into another sheet - sheet 4 in my case - along with any other rows that contained that specific text.
i have been using this code but it only copy pastes one row then stops rather than going through and copying any rows with "FAIL"
Sub Test()
For Each Cell In Sheets(1).Range("H:H")
If Cell.Value = "FAIL" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets(4).Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets(4).Select
End If
Next
End Sub
First post and brand new to VBA so apologies if too vague.

Try the code below (explanation inside the code as comments):
Option Explicit
Sub Test()
Dim Cell As Range
With Sheets(1)
' loop column H untill last cell with value (not entire column)
For Each Cell In .Range("H1:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
If Cell.Value = "FAIL" Then
' Copy>>Paste in 1-line (no need to use Select)
.Rows(Cell.Row).Copy Destination:=Sheets(4).Rows(Cell.Row)
End If
Next Cell
End With
End Sub

Try like this:
Option Explicit
Sub TestMe()
Dim Cell As Range
Dim matchRow As Long
With Worksheets(1)
For Each Cell In .Range("H:H")
If Cell.Value = "FAIL" Then
matchRow = .Cell.Row
.Rows(matchRow & ":" & matchRow).Select
.Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Worksheets(4).Select
Worksheets(4).Rows(matchRow).Select
Worksheets(4).Paste
.Select
End If
Next
End With
End Sub
The problem in your code is that you do not reference the worksheets all the time correctly. Thus it does not work correctly.
As a 2. step, you can try to avoid all the selections in your code, it is a best practice to avoid using either Select or Activate in Excel VBA.

Related

Adding data from one column to existing column in excel using Macros

I am new to excel and using macros, how can i achieve below inquiry
How to add data to another column by pressing a button in excel?
When user press "SAVE", data from column B2 will be added to column of column F.
I tried to do below code but i doesn't work
Sub ButtonSave_Click()
Range("B2").Value = Range("F" & Row).Insert
End Sub
How to deal with this?
thanks in advance!
Use the following and replace Activesheet with the actual sheet name e.g. Worksheets("Sheet1")
Code:
Option Explicit
Public Sub ButtonSave_Click()
With ActiveSheet '<== replace with actual sheet reference
.Range("F" & .Cells(.Rows.Count, "F").End(xlUp).Row + 1) = .Range("B2")
End With
End Sub
Row=Range("F1").End(xlDown).Offset(1,0).Row
Range("F" & Row).Value=Range("B2").Value

First blank ("") cell in column with IF formula

I have a macro that exactly copies one sheet's data into another.
Sub QuickViewRegMgmt()
("Reg Management").Select
Cells.Select
Selection.Copy
Sheets("Quick View Reg Mgmt").Select
Cells.Select
ActiveSheet.Paste
End Sub
I would like for this macro to also go to the last non-blank cell in Column C (or first blank, I really don't care either way). I tried simple end/offset code, e.g.
Range("A1").End(xldown).Offset(1,0).Select
My problem, however, is that the direct copy macro also copies the underlying formulas, which for Column C is an IF formula. Therefore, no cell in the column is actually empty, but rather they all have an IF formula resulting in a true/false value (respectively, a "" or VLOOKUP).
=IF(VLOOKUP('Reg Management'!$Y260,'Reg Guidance'!$A:$V,3,FALSE)=0,"",VLOOKUP('Reg Management'!$Y260,'Reg Guidance'!$A:$V,3,FALSE))
That means the end/offset code goes to the last cell in the column with the formula (C1000) instead of going to the first cell that has a value of "" (which is currently C260).
What code can I add to this macro to select the first cell that contains an IF formula resulting in a value of "" ---- which has the appearance of being blank?
After trying to be fancy with SpecialCells(), or using Find() or something I couldn't get it ...so here's a rather "dirty" way to do it:
Sub test()
Dim lastRow As Long, lastFormulaRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Dim i As Long
For i = lastRow To 1 Step -1
If Cells(i, 1).Formula <> "" And Cells(i, 1).Value = "" Then
lastFormulaRow = i
Exit For
End If
Next i
End Sub
Edit2: Here's one using .SpecialCells(). Granted I think we can whittle this down more, I like it better:
Sub lastRow()
Dim tempLastRow As Long
tempLastRow = Range("C" & Rows.Count).End(xlUp).Row
Dim lastRow As Range
Set lastRow = Columns(3).SpecialCells(xlCellTypeFormulas).Find(What:="", LookIn:=xlValues, LookAt:=xlWhole, searchdirection:=xlPrevious, after:=Range("C" & tempLastRow))
Debug.Print lastRow.Row
End Sub
It returns 10 as the row.
Edit: Be sure to add the sheet references before Range() and Cells() to get the last row. Otherwise, it's going to look at your active sheet to get the info.

Multiple Vlookups using VBA in one sub

I am trying to fill multiple columns in a sheet with vlookups from another sheet named "Go Live Data" in the same workbook, to the end of the range.
So, based off of the value starting in A6 in my sheet, I want to lookup to range A:K in sheet "Go Live Data" for cells starting in U6 to the end of the data filled in the tab (this will change dynamically). I want to repeat this for cells starting with V6 and W6.
This is the code that I have now, but it does not populate.
Sub VlookupGoLiveandBOP()
Dim Rng As Range, Dn As Range
Set Rng = Range(Range("A6"), Range("A" & Rows.Count).End(xlUp))
With Range("U6")
.Formula = "=IF(ISNA(VLOOKUP(A6,Go Live
Data!$A:$K,2,FALSE)),"""",VLOOKUP(A6,Go Live Data!$A:$K,2,FALSE))"
.AutoFill Destination:=Rng.Offset(, 66)
With Range("v6")
.Formula = "=IF(ISNA(VLOOKUP(A6,Go Live
Data!$A:$K,3,FALSE)),"""",VLOOKUP(A6,Go Live Data!$A:$K,3,FALSE))"
.AutoFill Destination:=Rng.Offset(, 66)
With Range("w6")
.Formula = "=IF(ISNA(VLOOKUP(A6,Go Live
Data!$A:$K,4,FALSE)),"""",VLOOKUP(A6,Go Live Data!$A:$K,4,FALSE))"
.AutoFill Destination:=Rng.Offset(, 66)
End With
Rng.Offset(, 66).Value = Rng.Offset(, 66).Value
End Sub
Am I on the wrong track? Thank you for your help.
Try the code below, it will help you assign the VLookup range correctly.
When using LKUpRng.Address(True, True, xlA1, xlExternal) the 4th parameter xlExternal adds also the sheet's name (and workbook if needed) with all the ' and ! needed.
Code
Option Explicit
Sub VlookupGoLiveandBOP()
Dim Rng As Range, Dn As Range
Dim LKUpRng As Range
Dim LkUpStr As String
Set LKUpRng = Sheets("Go Live Data").Range("A:K")
LkUpStr = LKUpRng.Address(True, True, xlA1, xlExternal) '<-- get the Range as a String, including the sheet's name
Set Rng = Range(Range("A6"), Range("A" & Rows.Count).End(xlUp))
Range("U6").Formula = "=IF(ISNA(VLOOKUP(A6," & LkUpStr & ",2,FALSE)),"""",VLOOKUP(A6," & LkUpStr & ",2,FALSE))"
End Sub

VBA Look through List

I've got the following code which gets the word dividend from a column and then takes the whole row and copy pastes it to a new sheet.
Sub SortActions()
Dim i&, k&, s$, v, r As Range, ws As Worksheet
Set r = [index(a:a,match("###start",a:a,),):index(a:a,match("###end",a:a,),)].Offset(, 6)
k = r.Row - 1
v = r
For i = 1 To UBound(v)
If LCase$(v(i, 1)) = "dividend" Then
s = s & ", " & i + k & ":" & i + k
End If
Next
s = Mid$(s, 3)
If Len(s) Then
Set ws = ActiveSheet
With Sheets.Add(, ws)
ws.Range(s).Copy .[a1]
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("20140701_corporate_action_servi").Select
Rows("2:2").Select
Selection.Copy2
Range("C32").Select
Sheets("Sheet11").Select
ActiveSheet.Paste
End With
End If
End Sub
Is there a way to make this dynamic. So if I want to search for more than word. For example if I have several rows with dividends and special dividends -> it would take all rows of dividends and all rows of special dividends and put them in separate sheets. I have tried ti with recording a macro it doesn't work as the words can differ. Maybe getting the content into a list would work. Please assist . Thanks
As suggested by #Macro Man , I am submitting images of an example sheet and sheet after filter with a simple macro for filtering one field. Please all credit to #Macro Man, it is for illustration in a simple way.
Simple code as follows.
Sub Filter1Field()
With Sheet1
.AutoFilterMode = False
With .Range("A1:H13")
.AutoFilter
.AutoFilter Field:=5, Criteria1:="Dividend"
End With
End With
End Sub
*****UPDATE*******
If your other criteria such as "Sp. Dividend" is other field but on the same row as shown in the image appended and you wish to copy to other sheet you can use the code given below. Another image shows results obtained on sheet2. You can adopt the code to your requrements.
You can use this code:
Sub Test2()
Dim LastRow As Long
Sheets("Sheet2").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
.Range("A1:H13").AutoFilter
.Range("A1:H13").AutoFilter field:=5, Criteria1:="Dividend"
.Range("A1:H13").AutoFilter field:=6, Criteria1:="=Sp. Dividend"
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Sheets("Sheet2").Range("A1")
End With
End Sub

For loop to change a specific cell in a formula

I have a formula that shows which rows in a specific column meet a set of criteria. When the formula is executed and applied to all rows, I run a loop to check which rows returned a value as a text, and then copy-pastes this cells to another worksheet:
Sub loop1()
Dim r As Range, c As Range
With Worksheets("Sheet1")
Set r = Range(.Range("AF2"), .Range("AF2").End(xlDown))
For Each c In r
If WorksheetFunction.IsText(c) Then
Range(.Cells(c.Row, "AF"), .Cells(c.Row, "AF")).Copy
Else
GoTo nextc
End If
With Worksheets("Sheet2")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
nextc:
Next c
End With
Application.CutCopyMode = False
End Sub
What I want to do now is to run the formula for 631 different names, copy-paste every name as a headline and then run loop1. I cant figure out though how to make the for loop work inside the formula.
Sub loop2()
Dim i As Integer
For i = 2 To 632
Sheets("Sheet1").Select
Range("AC2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]=""district1"",(IF(RC[2]=R2C33 ,(IF(RC[-18]>=1,0,(IF(RC[-16]>=1,0,IF(RC[-14]>=1,0,IF(RC[-12]>=1,0,IF(RC[-10]>=1,1,IF(RC[-8]>=1,1,IF(RC[-6]>=1,1,0))))))))),0)),0)"
Range("AC2").Select
Selection.AutoFill Destination:=Range("AC2:AC20753")
Range("AC2:AC20753").Select
Range("AG2").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Selection.Font.Bold = True
Sheets("Sheet1").Select
Application.Run "'Customers.xlsb'!loop1"
Next i
End Sub
The cells that need to be changed for every loop are, R2C33 to something like RiC33 (which doesn't work) and the "headline" Range("AG2").Select to something like Range("AGi").Select.
Anyone who could help?
The following code will do the trick:
Sub loop2()
Dim i As Integer
For i = 2 To 632
Sheets("Sheet1").Range("AC2:AC20753").FormulaR1C1 = _
"=IF(RC[-3]=""district1"",(IF(RC[2]=R" & i & "C33 ,(IF(RC[-18]>=1,0,(IF(RC[-16]>=1,0,IF(RC[-14]>=1,0,IF(RC[-12]>=1,0,IF(RC[-10]>=1,1,IF(RC[-8]>=1,1,IF(RC[-6]>=1,1,0))))))))),0)),0)"
Sheets("Sheet1").Range("AG" & i).Copy Destination:=Sheets("Sheet2").Range("A1")
Sheets("Sheet2").Range("A1").Font.Bold = True
Application.Run "'Customers.xlsb'!loop1"
Next i
End Sub
In order to let i be used within your String formula you have to stop the String " use & i & and continue the String ".
I have also changed your code to prevent the use of .Select, which is a no no in VBA.
This way it fills in your Formula copy's and changes the Font without selecting anything or changing sheets.
As Jeep noted you do however need to change Sheets(""Sheet2").Range("A1") as I don't know which cell you want to paste into.
Your first sub procedure might be better like this.
Sub loop1()
Dim r As Range, c As Range
With Worksheets("Sheet1")
Set r = Range(.Range("AF2"), .Range("AF2").End(xlDown))
For Each c In r
If WorksheetFunction.IsText(c) Then
Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = _
.Cells(c.Row, "AF").Value2
End If
Next c
End With
End Sub
Direct value transfer is preferred over a Copy, Paste Special, Values.
In the second sub procedure, you don't have to do anything but remove the 2 from R2C33; e.g. RC33. In xlR1C1 formula construction a lone R simply means the row that the formula is on and you are starting at row 2. You can also put all of the formulas in at once. Once they are in you can looop through the G2:G632 cells.
Sub loop2()
Dim i As Integer
With Sheets("Sheet1")
.Range("AC2:AC20753").FormulaR1C1 = _
"=IF(OR(AND(RC[-3]=""district1"", RC[2]=R2C33, RC[-18]>=1), SUM(RC[-16], RC[-14], RC[-12])>=1), 0, IF(SUM(RC[-10], RC[-8], RC[-6])>=1, 1, 0))"
For i = 2 To 632
.Range("AG" & i).Copy _
Destination:=Sheets("Sheet2").Somewhere
Sheets("Sheet2").Somewhere.Font.Bold = True
Application.Run "'Customers.xlsb'!loop1"
Next i
Next i
End Sub
I also tightened up your formula by grouping some of the conditions that would result in zero together with OR and AND functions.
The only thing remaining would be defining the Destination:=Sheets("Sheet2").Somewhere I left hanging.