Excel VBA, How to select rows based on data in a column? - excel

Sub SelectAllReleventText()
Do While Range(“A1”).Offset(1, 6) <> Empty
Rows(ActiveCell.Row).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Here is my script, I've been told it doesn't do what it is meant to, which I expected since this was my first attempt. I am coming up with a variable not defined error. I thought I defined the variable, but I guess it wasn't specific enough for Excel VBA.
This is what I am attempting to do.
In Workbook 1, On B6 there is an alphanumeric name, I want that row to be selected.
Go down one row, if there is text there select that row.
Continue till text is no longer prevalent.
Copy selected rows.
Paste into another workbook (Workbook2), into tab 1, starting on row 2, since row 1 has headers.
Thanks in advance. Just a heads up, I am using the Options Explicit in my VBA because I was told it was the "right way to do thing"...

Yes using Option Explicit is a good habit. Using .Select however is not :) it reduces the speed of the code. Also fully justify sheet names else the code will always run for the Activesheet which might not be what you actually wanted.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim lastRow As Long, i As Long
Dim CopyRange As Range
'~~> Change Sheet1 to relevant sheet name
With Sheets("Sheet1")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(i)
Else
Set CopyRange = Union(CopyRange, .Rows(i))
End If
Else
Exit For
End If
Next
If Not CopyRange Is Nothing Then
'~~> Change Sheet2 to relevant sheet name
CopyRange.Copy Sheets("Sheet2").Rows(1)
End If
End With
End Sub
NOTE
If if you have data from Row 2 till Row 10 and row 11 is blank and then you have data again from Row 12 then the above code will only copy data from Row 2 till Row 10
If you want to copy all rows which have data then use this code.
Option Explicit
Sub Sample()
Dim lastRow As Long, i As Long
Dim CopyRange As Range
'~~> Change Sheet1 to relevant sheet name
With Sheets("Sheet1")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(i)
Else
Set CopyRange = Union(CopyRange, .Rows(i))
End If
End If
Next
If Not CopyRange Is Nothing Then
'~~> Change Sheet2 to relevant sheet name
CopyRange.Copy Sheets("Sheet2").Rows(1)
End If
End With
End Sub
Hope this is what you wanted?
Sid

The easiest way to do it is to use the End method, which is gives you the cell that you reach by pressing the end key and then a direction when you're on a cell (in this case B6). This won't give you what you expect if B6 or B7 is empty, though.
Dim start_cell As Range
Set start_cell = Range("[Workbook1.xlsx]Sheet1!B6")
Range(start_cell, start_cell.End(xlDown)).Copy Range("[Workbook2.xlsx]Sheet1!A2")
If you can't use End, then you would have to use a loop.
Dim start_cell As Range, end_cell As Range
Set start_cell = Range("[Workbook1.xlsx]Sheet1!B6")
Set end_cell = start_cell
Do Until IsEmpty(end_cell.Offset(1, 0))
Set end_cell = end_cell.Offset(1, 0)
Loop
Range(start_cell, end_cell).Copy Range("[Workbook2.xlsx]Sheet1!A2")

Related

Is there a way to run Autofilter to more than one column simultaneously in Excel VBA?

I have a cell designated as a Search Box for user entry (called 'UserSearch') and need to be able to use this input to filter multiple columns at the same time. For example, if the user searched for 'Apple', I need the VBA code to filter out all rows where that word appears, even if it appeared in another column. I am currently stuck on only being able to filter out one column at a time but this input may also appear in another column but the row won't be filtered because it may have gotten filtered out by the column before it.
My current code is below is:
Sub search()
With ActiveSheet.Range("$a$4:$j$30")
.AutoFilter Field:=1, Criteria1:="=*" & Range("UserSearch") & "*", Operator:=xlOr
.AutoFilter Field:=2, Criteria1:="=*" & Range("UserSearch") & "*", Operator:=xlOr
.AutoFilter Field:=3, Criteria1:="=*" & Range("UserSearch") & "*"
End With
End Sub
As you can see, my goal is to be able to run autofilter on all 3 fields simultaneously (essentially treating the 3 columns as just one) but the code above contradicts each other and no rows are returned. Anyone have any idea by using autofilter?
You cannot use .AutoFilter for this but yes using a small vba code you can achieve what you want
Let's say your worksheet looks like this
Paste this code in a module
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rngHide As Range
Dim FoundIt As Long, i As Long, lRow As Long
Dim SearchString As String
'~~> Your search string
SearchString = "Apple"
'~~> Change this to the relevant sheet
Set ws = Sheet1
'~~> Find the last row
' https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba
lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
'~~> Loop through 4 to last row to find the search string
For i = 4 To lRow
On Error Resume Next
FoundIt = Application.WorksheetFunction.Match(SearchString, ws.Rows(i), 0)
On Error GoTo 0
'~~> Create a range which needs to be hidden
If FoundIt = 0 Then
If rngHide Is Nothing Then
Set rngHide = ws.Rows(i)
Else
Set rngHide = Union(rngHide, ws.Rows(i))
End If
End If
FoundIt = 0
Next i
'~~> Hide it if applicable
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
End Sub
I have commented the code so you should not have a problem understanding it. but if you do then simply ask.
In Action
These two macros are more basic, but accomplish the same task as Sid's answer...
The first macro loops through the range and checks the first three cells in the current row for the search text, if found in any of the cells, it will loop to the next row. If no cells contain the search text, the row will be hidden
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'Define your worksheet
Dim UserSearch As String: UserSearch = ws.Range("A2").Value 'Assign the range for the user entry, change as needed
For Each cel In ws.Range("A4", ws.Cells(ws.Rows.Count, 1).End(xlUp)) 'Loop through the range
'Using (= and Or) test if any of the first three cells in the current row contain the search text
If cel.Value = UserSearch Or cel.Offset(, 1).Value = UserSearch Or cel.Offset(, 2).Value = UserSearch Then
'If the search text is found in any of the cells then loop to the next row
Else
'If the search text is not in any of the cells then hide the row
cel.EntireRow.Hidden = True
End If
Next cel
The second macro loops through the range and checks the first three cells in the current row for the search text, if not found, the row will be hidden
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'Define your worksheet
Dim UserSearch As String: UserSearch = ws.Range("A2").Value 'Assign the range for the user entry, change the range as needed
For Each cel In ws.Range("A4", ws.Cells(ws.Rows.Count, 1).End(xlUp)) 'Loop through the range
'Using (<> and And) test the first three cells in the current row
If cel.Value <> UserSearch And cel.Offset(, 1).Value <> UserSearch And cel.Offset(, 2).Value <> UserSearch Then
'If the search text is not found hide the current row
cel.EntireRow.Hidden = True
End If
Next cel

Conditional Loop in VBA

Looking for a conditional looping, perhaps Do Until or some similar that will run through the range of cells (say A3:A13) and if there’s a blank cell within that range there would be a command that will automatically hide entire row where the blank cell sits.(if the blank cell is A5 this mean entire row 5 would be hidden) The command will run through until all the the blank cells are detected and automatically all the rows associated with blank cells are hidden until it reach the end of the range A13. Any suggestions kindly welcome.
You can try something like this. First we loop through the range("A" & LRow) it will map all the blank cells and hide all in one go.
Option Explicit
Sub HideRows()
Dim ws As Worksheet
Dim LRow As Long
Dim HideRng As Range
Dim i As Long
Set ws = ActiveSheet
With ws
LRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To LRow
If Len(Trim(.Range("A" & i).value)) = 0 Then
If HideRng Is Nothing Then
Set HideRng = .Rows(i)
Else
Set HideRng = Union(HideRng, .Rows(i))
End If
End If
Next i
If Not HideRng Is Nothing Then HideRng.EntireRow.Hidden = True
Set HideRng = Nothing
End With
End Sub

How can I repeat code through entire data?

I have written a few lines of code that work like I want them too but I don't know how to repeat it through all rows of my data.
This probably seems like a rather simple thing but since I started VBA just a few days ago I struggle with this line of code
If I continue with ActiveCell.Offset(-1,-4) after my code it's a bug and I don't know how to repeat the code through all rows.
Sub SelectRowsWithNoBlanks()
Range("A2").Select
If ActiveCell.Offset(0, 0).Value <> "" And ActiveCell.Offset(0, 1) <> "" And ActiveCell(0, 1) <> "" And ActiveCell(0, 1) <> "" Then
Range(ActiveCell, Cells(ActiveCell.Row, ActiveCell.Column + 4)).Select
End If
End Sub
#SiddharthRout As I don't have Access to the data yet I can't tell. But I thought extending the code for more columns later on wouldn't be a problem. So in the code I have written now I was checking for the columns A-D but I thought I could easily add the "checking" for more columns if needed – Anna von Blohn 43 secs ago
In that case, here is a sample code.
Logic
As #Pᴇʜ mentioned avoid the use of .Select. Work with the objects.
Find the last row and loop through the rows. To find the last you you may want to see This
One way (which I am using) is to count the number of cells which are filled using Application.WorksheetFunction.CountA. So if it is columns A to D then there should be 4 cells to be filled to consider the "row" as filled. Similarly for Cols A to E, there should be 5 cells to be filled to consider the "row" as filled as so on.
Code
I have commented the code. So if you have a problem understanding it, let me know.
Option Explicit
Sub SelectRowsWithNoBlanks()
Dim ws As Worksheet
Dim lRow As Long, i As Long
Dim myRange As Range, rng As Range
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Find the last row in Col A
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Loop through the rows
For i = 2 To lRow
'~~> Change this as applicable
Set rng = .Range("A" & i & ":D" & i)
'~~> Check if the range is completely filled
If Application.WorksheetFunction.CountA(rng) = rng.Columns.Count Then
'~~> Store the range in a range object
If myRange Is Nothing Then
Set myRange = rng
Else
Set myRange = Union(myRange, rng)
End If
End If
Next i
End With
'If Not myRange Is Nothing Then Debug.Print myRange.Address
'~~> Check if any filled rows were found
If Not myRange Is Nothing Then
With myRange
'
'~~> Do what you want with the range
'
End With
Else
MsgBox "No filled rows were found"
End If
End Sub

Transferring rows into another sheet

I am trying to transfer two rows of Sheet1 (randomly and based on certain criteria) into Sheet3.
The values in cells "P2" and "P5" indicate the row number to be transferred, and column "A" has row numbers.
There's no possibility that values in "P2" and "P5" could match multiple rows in column "A". They should match 1 row each, so only one row should be copied per "P2" and "P5". Yet, sometimes I see multiple rows getting copied.
Below is the code:
Sub copyrows()
Dim tfRow As Range, cell As Object
Set tfRow = Range("A1:A") 'Range which includes the values
For Each cell In tfRow
If IsEmpty(cell) Then
Exit Sub
End If
If cell.Value = Range("P2").Value Then
cell.EntireRow.Copy
Sheet3.Select 'Target sheet
ActiveSheet.Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
Sub copyrows2()
Dim tfRow2 As Range, cell As Object
Set tfRow2 = Range("A1:A") 'Range which includes the values
For Each cell In tfRow2
If IsEmpty(cell) Then
Exit Sub
End If
If cell.Value = Range("P5").Value Then
cell.EntireRow.Copy
Sheet3.Select 'Target sheet
ActiveSheet.Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
As #urdearboy mentioned in the commnets above, you need to add a row to your second A column range to avoid getting the error.
To merge two conditions, in your case add an Or to your If.
To run the code faster, don't Select and Activate different sheets, it takes a long time for the code to run. Instead, use a Range object, like CopyRng and every time the if criteria is ok, you add that cell to the range using the Union function.
Read HERE about the Union functionality.
More comments inside the code's notes below.
Modified Code
Option Explicit
Sub copyrows()
Dim Sht1 As Worksheet, Sht3 As Worksheet
Dim tfRow As Range, C As Range ' use Range not Object, also try not to use Cell it's close to Cells
Dim CopyRng As Range
Dim LastRow As Long
Set Sht1 = Sheet1
Set Sht3 = Sheet3
With Sht1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column A
Set tfRow = .Range("A1:A" & LastRow) 'Range which includes the values
For Each C In tfRow
If IsEmpty(C) Then
Exit Sub
End If
If C.Value = .Range("P2").Value Or C.Value = .Range("P5").Value Then ' use Or to combine both scenarios
If Not CopyRng Is Nothing Then
Set CopyRng = Application.Union(CopyRng, C) ' use Union to merge multiple ranges
Else
Set CopyRng = C
End If
End If
Next C
End With
' make sure there is at least one cells in your merged range
If Not CopyRng Is Nothing Then
' get last row with data in "sheet3"
LastRow = Sht3.Cells(Sht3.Rows.Count, "A").End(xlUp).Row
CopyRng.EntireRow.Copy Destination:=Sht3.Range("A" & LastRow + 1)
End If
End Sub

Excel expression to copy rows but remove blank rows

I need to copy data from one worksheet into another. However, I need a conditional copy operation that will skip rows based on criteria.
For example, if I start with...
Active Value
yes 1
no 2
no 3
yes 4
no 5
no 6
I only want to copy rows that are Active=yes, so I would end up with...
Value
1
4
Can someone show me how this is done with 1) a macro and 2) a formula?
Formula approach:
suppose your data are in sheet1, range A2:B7.
Then use this formula in sheet2 cell A2:
=IFERROR(INDEX(Sheet1!B:B,SMALL(IF(Sheet1!$A$2:$A$7="yes",ROW(Sheet1!$A$2:$A$7)),ROW()-ROW($A$2)+1)),"")
with array entry (CTRL+SHIFT+ENTER) and then drag it down.
VBA approach:
You can use AutoFilter:
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheet1 and Sheet2 to suit
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
With ws1
'assumung that your data stored in column A:B, Sheet1
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A1:B" & lastrow)
'clear all filters
.AutoFilterMode = False
With rng
'apply filter
.AutoFilter Field:=1, Criteria1:="yes"
On Error Resume Next
'get only visible rows
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'copy range
If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws2.Range("A1")
'clear all filters
.AutoFilterMode = False
End With
Application.CutCopyMode = False
End Sub
Note, if you want to copy only Value column, change
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
to
Set rngToCopy = .Offset(, 1).Resize(, .Columns.Count - 1).SpecialCells(xlCellTypeVisible)
It's easy enough with a macro. Assuming you're copying from the first sheet to the second sheet, and that your sample above is in columns A and B, you could do the following:
Public Sub ConditionalCopy()
Dim copyRng As Range
Set copyRng = Worksheets(1).Range("B2:B7")
Dim pasteRng As Range
Set pasteRng = Worksheets(2).Range("A2")
Dim i As Long
i = 0
For Each cell in copyRng.Cells
If cell.Offset(0, -1).Value2 = "yes" Then
pasteRng.Offset(i,0).Value2 = cell.Value2
i = i + 1
End If
Next cell
End Sub
Doing it with a formula presents a challenge in terms of not leaving any blank rows on the second sheet. It would be pretty trivial to just use the following in the second sheet:
=If(A2 = "yes",b2,"")
And copy that down, but you're going to end up with blank rows that you'll have to go back and delete yourself. If you have the ability to use the macro, it's straightforward enough that I would go that route rather than sinking too much effort into devising a formula. The more I think about it, the more I feel like it has to be a programmatic solution to avoid double references.
If you use seperate counters for the source and destination rows, and use cell references rather than ranges the following routine should do the trick
Public Sub copyactivevalue()
Dim i As Integer
Dim j As Integer
Dim acts As Excel.Worksheet
Dim news As Excel.Worksheet
Set acts = Excel.Worksheets("sheet1")
Set news = Excel.Worksheets("sheet2")
With acts
j = 2
For i = 2 To 7
If acts.Cells(i, 1).Value = "yes" Then
news.Cells(j, 1) = acts.Cells(i, 2).Value
j = j + 1
End If
Next
End With
Set acts = Nothing
Set news = Nothing
End Sub
Hope this helps

Resources