How can I repeat code through entire data? - excel

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

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

VBA code in excel operates inconsistently with very simple code

I wrote some pretty simple VBA (excel macros) code to manage my audio licencing excel experience. The code is supposed to look through the excel sheet in column 3, look for any that have "AMC" in their column, and then copy and paste the row to sheet 2 and continue searching through entire excel document. This code is very simple and worked once right before it stopped working right. It only takes the very last AMC value and puts that on sheet 2 but not the other 5 rows that have AMC in their column 3 value.
Please help! I would appreciate it very much :)
-Jeremy
VBA Code:
Sub CommandButton1_Click()
a = Worksheets("Sheet1").UsedRange.Rows.Count
b = 0
For i = 2 To a
If Worksheets("Sheet1").Cells(i, 3).Value = "AMC" Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet2").Activate
' b = ActiveSheet.UsedRange.Rows.Count
Worksheets("Sheet2").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet1").Activate
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select
End Sub
This should solve your problem :
If Worksheets("Sheet1").Cells(i, 3).Value = "AMC" Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Cells(b + 1, 1).Select
b = b + 1
ActiveSheet.Paste
Worksheets("Sheet1").Activate
End If
You could use Instr and Union.
Union is very efficient as you store all the qualifying ranges in memory and then write out only once to the sheet. Much less expensive operation than continually writing out to the sheet.
Instr allows you to use vbBinaryCompare which means you are doing a case sensitive match i.e. only AC not ac will be matched on.
The code belows avoids .Activate, which is again an expensive operation that isn't required.
UsedRange means you may be looping many more rows than required. You only want to loop to the last populated row in column C of sheet 1, as that is the column you are testing. Hence, I use .Cells(.Rows.Count, C").End(xlUp).Row to find that last row.
Use Option Explicit - research why! It will make your VBA life soooooo much better.
Code:
Option Explicit
Sub CommandButton1_Click()
Dim lastRow As Long, sSht As Worksheet, tSht As Worksheet, loopRange As Range
Set sSht = ThisWorkbook.Worksheets("Sheet1")
Set tSht = ThisWorkbook.Worksheets("Sheet2")
With sSht
Set loopRange = .Range("C2:C" & .Cells(.Rows.Count, C").End(xlUp).Row)
End With
Dim rng As Range, unionRng As Range
For Each rng In loopRange
If InStr(1, rng.Value, "AC", vbBinaryCompare) > 0 Then
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, rng)
Else
Set unionRng = rng
End If
End If
Next rng
If Not unionRng Is Nothing Then unionRng.EntireRow.Copy tSht.Cells(1, 1)
End Sub

Hiding row if cell equals next visible cell

I am trying to write a macro that hides the row if the cell value equals the next visible cell in that column and loops through the whole column. I have read that SpecialCells(xlCellTypeVisible) only works up to 8192 cells and my spreadsheet has 15,000 rows.
I have tried something like this but want to restrict it to only visible cells
Sub Test()
For i = 7 To 15258
If Range("P" & i).Value = Range("P" & i + 1).Value Then
Rows(i).Hidden = True
End If
Next i
End Sub
I have tried to search for a solution but haven't been able to find one yet.
Thanks!
I'd be surprised if this couldn't be optimized just a little bit, but it will work for what you are needing.
You can follow the comments within the code itself to kind of get a sense of what it's doing, but in a nutshell, you are using a For...Next statement to loop through your visible cells. For each visible cell, you will search for the next visible cell and then check to see if that matches. If it does, you add that cell to a special range that tracks all the rows to hide at the end of the code, then hide it.
Sub Test()
Dim ws As Worksheet, lookupRng As Range, rng As Range, lstRow As Long
Set ws = ThisWorkbook.Worksheets(1)
lstRow = 15258
Set lookupRng = ws.Range("P7:P" & lstRow)
Dim rngToHide As Range, i As Long
For Each rng In lookupRng.SpecialCells(xlCellTypeVisible)
Application.StatusBar = "Checking row " & rng.Row & " for matches."
For i = rng.Row + 1 To lstRow 'Loop through rows after rng
If Not ws.Rows(i).Hidden Then 'Check if row is hidden
If rng.Value = ws.Cells(i, "P") Then 'check if the non-hidden row matches
If rngToHide Is Nothing Then 'Add to special range to hide cells
Set rngToHide = ws.Cells(i, "P")
Else
Set rngToHide = Union(rngToHide, ws.Cells(i, "P"))
End If
End If
Exit For 'Exit the second For statement
End If
Next i
Next rng
Application.StatusBar = "Hiding duplicate rows"
If Not rngToHide Is Nothing Then rngToHide.EntireRow.Hidden = True
Application.StatusBar = False
End Sub

How to copy specific cells from each row in another sheet if certain condition is met?

So my problem is this. I have a workbook with lets say 2 sheets. I have automatically created sheet2 from another program and sheet1 where I would like only some of the information from sheet2.
I am now trying to create a macro that would check each row starting from 14 with the value in E% greater than 15. If the condition is met I would like the macro to copy cell value from C% and E% to sheet1 lets say in A5 and B5 and then proceed to next row in sheet2 pasting the valued to A6 B6 and so on.
Sub Test()
Dim rng As Range
Dim lastRow As Long
Dim cell As Variant
With Sheets("Sheet2")
lastRow = .Range("E" & .Rows.Count).End(xlUp).Row
Set rng = .Range("E14:E" & lastRow)
For Each cell In rng
If cell.Value > 15 Then
'And here is where it gets bugged. I know theres something wrong with the .select but I couldnt think of any other way to
'pick only just the 2 cells needed.
Range(cell.Offset(0, -1), cell.Offset(0, 0)).Select
Selection.Copy
'In here there should also be some code to select where to place the copyed
'data but since it already got bugged couldnt really find a solution for
'it..
Sheets("Sheet1").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
End If
Next
End With
End Sub
so I guess i'll put it together:
Sub Test()
Dim rng As Range
Dim lastRow As Long
Dim cell As Variant
dim count as long
count = 0
With Sheets("Sheet2")
lastRow = .Range("E" & .Rows.Count).End(xlUp).Row
Set rng = .Range("E14:E" & lastRow)
For Each cell In rng
If cell.Value > 15 Then
'And here is where it gets bugged. I know theres something wrong with the .select but I couldnt think of any other way to
'pick only just the 2 cells needed.
Range(cell.Offset(0, -1), cell.Offset(0, 0)).Select
Selection.Copy
'maybe use: Range(cell.Offset(0, -1), cell.Offset(0, 0)).copy
'In here there should also be some code to select where to place the copyed
'data but since it already got bugged couldnt really find a solution for
'it..
Sheets("Sheet1").Activate
Range("A5", B5).offset(count, 0).PasteSpecial 'this will make it so that it starts in a5, and moves down a row each time
count = count + 1 'dont forget to increment count
Sheets("Sheet2").Activate
End If
Next
End With
End Sub
and that's kinda a rough thing..
you might include some error handling like: if not cell.value = "" then or also if not isNumeric(cell.value) then and those together would ensure you're only processing non blank cells with numbers.

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

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")

Resources