I have an excel sheet, and I'm trying. to write VBA code to delete rows from the excel sheet based on the following conditions:
If Column A contains strings "string1" and "string2".
OR
If Column B contains strings "string3" or "string4"
Im using the below code:
Sub DeleteRows()
Dim rng As Range
Dim pos As Integer
Set rng = ActiveSheet.UsedRange
For i = rng.Cells.Count To 1 Step -1
pos = InStr(LCase(rng.Item(i).Value), "string1"))
If pos > 0 Then
rng.Item(i).EntireRow.Delete
End If
Next i
End Sub
But it only deletes rows if the single string is located in any column , and I couldn't specify the column name to search in.
Any help is appreciated.
Thanks,
With rng.Cells.Count you loop through all cells in the range:
Dim i As Long
For i = rng.Columns(2).Cells.Count To 1 Step -1
will only loop through the cells of column 2.
The issue is with your Loop - you're looping through each Item in the range, rather than each row
Try the below
Sub DeleteRows()
Dim rng As Range
Dim rownum As Long
Set rng = ActiveSheet.UsedRange
For rownum = rng.rows.Count To 1 Step -1
If LCase(Rng.Cells(rownum, 1) Like "*String1*" And _
LCase(rng.Cells(rownum, 1) Like "*String2*" Or _
LCase(rng.Cells(rownum, 2) Like "*String3*" Or _
LCase(rng.Cells(rownum, 2) Like "*String4*" Then
rng.Cells(rownum, 1).EntireRow.Delete
End If
Next
End Sub
Related
I am trying to write a VBA code where I want to populate DATA from a worksheet Range A to AQ spanning over multiple Rows. AQ contains Value "Open" or "Closed". I want to get the rows where AQ value is closed. I tried using the AutoFilter. This is working fine to an extent. But I have to use 2 For loops. One for Each Row and another for Each Column to populate Row wise, column by column into the list box
My Code as follows:
Note : Actual contents start from 6th Row where 6 contains the headers and data starts from 7th Row
Dim i As Long
Dim rowRange As Range
Dim AllData(1 To 1000, 1 To 43) As String
lstRecords.ColumnCount = 43
Set shDSR = mydata1.Sheets("DSR")
last_Row = shDSR.Cells(Rows.Count, 1).End(xlUp).Row
shDSR.AutoFilterMode = False
shDSR.Range("A6:AQ" & last_Row).AutoFilter Field:=43, Criteria1:="CLOSED"
Set rng = shDSR.Range("A6:AQ" & last_Row).SpecialCells(xlCellTypeVisible)
Dim filtrRow() As String
Dim rowCnt As Long
'Me.lstRecords.Clear
rowCnt = 0
If rng.Count > 0 Then
Me.lstRecords.Clear
Me.lstRecords.ColumnCount = rng.Columns.Count
For Each Row In rng.Rows
Me.lstRecords.AddItem
rowCnt = rowCnt +1
filterRow = Range(Row.Address)
'Me.lstRecords.List() = filterRow ''This throws error Type Mismatch so not using
For i = 1 To Row.Columns.Count
AllData(rowCnt, i) = Row.Cells(1, i).Value ''Move to Array
Me.lstRecords.List(rowCnt - 1, i - 1) = filterRow(1, i)'Buggy error when i = 11
Next
Next
'' Following segment works. Add data to Array and then populate ListBox from Array
Me.lstRecords.List() = AllData
Else
MsgBox "No data matches the filter criteria."
End If
Above Code has both approaches
a) Trying to load directly from excel Range (actually using filterRow, but can also directly use range with same issue). But, this approach stops always when i=11 with Invalid property error. I tried changing the data contents etc still same issue
Another Issue when Not taking the array based approach, only one line is added, so in affect only last line is available in the list box
b) Using the AllData array. I load all the row data (matching criteria) into the array and finally populate the listbox from array. THIS WORKS. But I do not like this approach
Can some one please point out where it is going wrong.
Thanks in advance
Problem is that filters create a non contiguous range consisting of areas which you have to iterate separately.
Option Explicit
Sub demo()
Dim mydata1 As Workbook, shDSR As Worksheet
Dim rng As Range, a As Range, r As Range
Dim last_row As Long, n As Long
Dim i As Long, rowCnt As Long
Dim ListData() As String
' change this
Set mydata1 = ThisWorkbook
Set shDSR = mydata1.Sheets("DSR")
With shDSR
.AutoFilterMode = False
last_row = .Cells(.Rows.Count, "AQ").End(xlUp).Row
.Range("A6:AQ" & last_row).AutoFilter Field:=43, Criteria1:="CLOSED"
Set rng = .Range("A6:AQ" & last_row).SpecialCells(xlCellTypeVisible)
.AutoFilterMode = False
End With
' clear listbox
With Me.lstRecords
.Clear
.ColumnCount = rng.Columns.Count
End With
'iterate areas and rows to count visible rows
For Each a In rng.Areas
n = n + a.Rows.Count
Next
rowCnt = 0
If n > 1 Then
' size array
ReDim ListData(1 To n, 1 To rng.Columns.Count)
' fill array
For Each a In rng.Areas
For Each r In a.Rows
rowCnt = rowCnt + 1
For i = 1 To UBound(ListData, 2)
ListData(rowCnt, i) = r.Cells(1, i).Value ''Move to Array
Next
Next
Next
' populate ListBox from Array
Me.lstRecords.List() = ListData
Else
MsgBox "No data matches the filter criteria."
End If
End Sub
All -
I have a 2 sheet excel.
Sheet 1 is three columns (name, date, value)
Sheet 2 is name.
I want to write a VBA script that displays all of Sheet 1 data that does NOT have any of the name field listed in Sheet 2 anywhere in sheet 1 (name can appear in different columns so ideally it would search all cells in Sheet 1) to appear in sheet 3
See the sample image for a rough idea of what I"m hoping to accomplish. I have searched but have not had luck.
If you have Excel 365 you can use the Dynamic Array formulas
=LET(Names,FILTER(Sheet1!$C:$E,Sheet1!$C:$C<>""),FILTER(Names,ISERROR(MATCH(INDEX(Names,,1),Sheet2!$G:$G,0))))
Example:
Data (Sheet1)
Exclusion List (Sheet2)
Result
Note: this excludes the headers because the header label Name is present in both the Data column and the Exclusion column so be sure to maintain that
Without Excel 365. I'd recommend a UDF
Function FilterList(ByVal Data As Range, ByVal Exclusion As Range) As Variant
Dim Res As Variant
Dim Dat As Variant
Dim Excl As Variant
Dim rw As Long
Dim idx As Long
Dim cl As Long
Dim ExcludeIt As Variant
Dim Cols As Long
Dim TopRow As Long
ReDim Res(1 To Application.Caller.Rows.Count, 1 To Application.Caller.Columns.Count)
If IsEmpty(Data.Cells(1, 1)) Then
TopRow = Data.Cells(1, 1).End(xlDown).Row
Set Data = Data.Resize(Data.Rows.Count - TopRow).Offset(TopRow - 1)
End If
If IsEmpty(Data.Cells(Data.Rows.Count, 1)) Then
Set Data = Data.Resize(Data.Cells(Data.Rows.Count, 1).End(xlUp).Row - Data.Row + 1)
End If
Dat = Data.Value
Excl = Exclusion.Columns(1).Value
Cols = Application.Min(UBound(Dat, 2), UBound(Res, 2))
idx = 0
For rw = 1 To UBound(Dat, 1)
ExcludeIt = Application.Match(Dat(rw, 1), Excl, 0)
If IsError(ExcludeIt) Then
idx = idx + 1
For cl = 1 To Cols
Res(idx, cl) = Dat(rw, cl)
Next
End If
Next
For rw = 1 To UBound(Res, 1)
For cl = IIf(rw <= idx, UBound(Dat, 2) + 1, 1) To UBound(Res, 2)
Res(rw, cl) = vbNullString
Next
Next
FilterList = Res
End Function
Enter it as an Array Formula (complete it with Ctrl+Shift+Enter) in a range large enough to hold the returned data (can be larger), and pass it your input Data range and Exclusion range (both as whole columns)
=FilterList(Sheet1!$C:$E,Sheet2!$G:$G)
Welcome to Stack Overflow!
You did not say where the source table and criteria table begin, or where to place the result of the "anti-filter". I wrote this code on the assumption that they all start at the first cell of the worksheet, A1:
Sub AntiFilter()
Dim aSource As Range, aCriteria As Range, oCell As Range, oTarget As Range, countCells As Long
Set aSource = Worksheets("Sheet1").Range("A1").CurrentRegion
countCells = aSource.Columns.Count
Set aCriteria = Worksheets("Sheet2").Range("A1").CurrentRegion
Set oTarget = Worksheets("Sheet3").Range("A1")
aSource.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=aCriteria, Unique:=False
For Each oCell In Application.Intersect(aSource, aSource.Columns(1))
If oCell.RowHeight < 1 Then
oCell.Resize(1, countCells).Copy Destination:=oTarget
Set oTarget = oTarget.Offset(1, 0)
End If
Next oCell
On Error Resume Next
aSource.Worksheet.ShowAllData
On Error GOTO 0
End Sub
Workbook with macro, test data and examples of selection criteria on Sheet2
If the macro does not work as expected, make sure that you have sheets named Sheet1, Sheet2, and Sheet3 in your workbook, and that the source data range and criteria range start with cells A1. If this is not the case, make the necessary changes to the text of the macro:
We have two worksheets.
Source worksheet is "profes"
Target worksheet is "primaria"
The data common to both worksheets is the name column.
ie: David Smith Weston appears in both worksheets.
We need to "lookup" each students name and paste values from "profes" to "primaria". I have most of the code working already BUT I don't know how to add the "lookup" part. As you can see it's wrong.
Sub Button1_Click()
Set Source = ActiveWorkbook.Worksheets("profes")
Set Target = ActiveWorkbook.Worksheets("primaria")
j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("N5:R1000") ' Do 100 rows
**If Source.Cells(j, "C").Value = Target.Cells(j, "A").Value** Then
Target.Cells(j, "N").Value = Source.Cells(j, "D").Value
j = j + 1
End If
Next c
End Sub
When comparing 2 ranges between 2 worksheets, you have 1 For loop, and replace the second loop with the Match function.
Once you loop over your "profes" sheet's range, and per cell you check if that value is found within the second range in "primaria" sheet, I used LookupRng, as you can see in the code below - you will need to adjust the range cording to your needs.
Code
Option Explicit
Sub Button1_Click()
Dim Source As Worksheet, Target As Worksheet
Dim MatchRow As Variant
Dim j As Long
Dim C As Range, LookupRng As Range
Set Source = ActiveWorkbook.Worksheets("profes")
Set Target = ActiveWorkbook.Worksheets("primaria")
' set up the Lookup range in "primaria" sheet , this is just an example, modify according to your needs
Set LookupRng = Target.Range("A2:A100")
For Each C In Source.Range("N5:R1000") ' Do 100 rows
If Not IsError(Application.Match(C.Value, LookupRng, 0)) Then ' Match was successfull
MatchRow = Application.Match(C.Value, LookupRng, 0) ' get the row number from "primaria" sheet where match was found
Target.Cells(C.Row, "N").Value = Source.Cells(MatchRow, "D").Value
End If
Next C
End Sub
Use the worksheet's MATCH function to locate names from the source column C in the target's column A.
Your supplied code is hard to decipher but perhaps this is closer to what you want to accomplish.
Sub Button1_Click()
dim j as long, r as variant
dim source as worksheet, target as worksheet
Set Source = ActiveWorkbook.Worksheets("profes")
Set Target = ActiveWorkbook.Worksheets("primaria")
with source
for j = 5 to .cells(.rows.count, "C").end(xlup).row
r=application.match(.cells(j, "C").value2, target.columns("A"), 0)
if not iserror(r) then
target(r, "D").resize(1, 5) = .cells(j, "N").resize(1, 5).value
end if
next j
end with
End Sub
I need the row/column combinations marked with an 'X' in my table to be available as three columns in another sheet.
The first column will consist of the cell address,
the second column will have the Row Name, and
the third column will have the Column name of the marked cells.
VLookUp and Index/Match are not helping.
Expected result:
You might get away with something as lazy as, you would change the sheets and the target range srcSht.Range("A1:C5") as appropriate:
Option Explicit
Sub test()
Dim wb As Workbook
Dim srcSht As Worksheet
Dim destSht As Worksheet
Set wb = ThisWorkbook
Set srcSht = wb.Sheets("Sheet1")
Set destSht = wb.Sheets("Sheet2")
Dim targetRange As Range
Set targetRange = srcSht.Range("A1:C5")
Dim loopArray()
loopArray = targetRange.Value2
Dim currRow As Long
Dim currCol As Long
Dim counter As Long
For currRow = LBound(loopArray, 1) To UBound(loopArray, 1)
For currCol = LBound(loopArray, 2) To UBound(loopArray, 2)
If LCase$(loopArray(currRow, currCol) )= "x" Then
counter = counter + 1
destSht.Cells(counter, 1) = targetRange.Cells(currRow, currCol).Address
destSht.Cells(counter, 2) = "Column " & targetRange.Cells(currRow, currCol).Column
destSht.Cells(counter, 3) = "Row " & targetRange.Cells(currRow, currCol).Row
End If
Next currCol
Next currRow
End Sub
This array formula seems to be working for me
=IFERROR(ADDRESS(SMALL(IF($A$1:$C$6="X",ROW($A$1:$C$6)*100+COLUMN($A$1:$C$6)),ROW())/100,MOD(SMALL(IF($A$1:$C$6="X",ROW($A$1:$C$6)*100+COLUMN($A$1:$C$6)),ROW()),100)),"")
but I think could be done more tidily with AGGREGATE.
Also there's no particular reason for multiplying by 100, multiplying by the exact number of columns in the array plus 1 would be better.
Here it is with AGGREGATE
=IFERROR(ADDRESS(AGGREGATE(15,6,(ROW($A$1:$C$6)*100+COLUMN($A$1:$C$6))/($A$1:$C$6="X"),ROW())/100,MOD(AGGREGATE(15,6,(ROW($A$1:$C$6)*100+COLUMN($A$1:$C$6))/($A$1:$C$6="X"),ROW()),100)),"")
EDIT
Here is a more general solution for a 2d range of any size anywhere on the sheet.
For the row:
=IFERROR(INDEX($A$2:$A$7,AGGREGATE(15,6,((ROW($B$2:$D$7)-ROW($B$2))*COLUMNS($B$2:$D$7)+COLUMN($B$2:$D$7)-COLUMN($B$2))/($B$2:$D$7="X"),ROW())/COLUMNS($B$2:$D$7)+1),"")
For the column:
=IFERROR(INDEX($B$1:$D$1,MOD(AGGREGATE(15,6,((ROW($B$2:$D$7)-ROW($B$2))*COLUMNS($B$2:$D$7)+COLUMN($B$2:$D$7)-COLUMN($B$2))/($B$2:$D$7="X"),ROW()),COLUMNS($B$2:$D$7))+1),"")
For the cell address:
=IFERROR(ADDRESS(AGGREGATE(15,6,((ROW($B$2:$D$7)-ROW($B$2))*COLUMNS($B$2:$D$7)+COLUMN($B$2:$D$7)-COLUMN($B$2))/($B$2:$D$7="X"),ROW())/COLUMNS($B$2:$D$7)+ROW($B$2),
MOD(AGGREGATE(15,6,((ROW($B$2:$D$7)-ROW($B$2))*COLUMNS($B$2:$D$7)+COLUMN($B$2:$D$7)-COLUMN($B$2))/($B$2:$D$7="X"),ROW()),COLUMNS($B$2:$D$7))+COLUMN($B$2)),"")
Here's a similar way to get a similar result:
Sub listCells()
Dim rIn As Range, c As Range, rOut As Range
Set rIn = Sheets("Sheet1").Range("B2:D7") 'input range
Set rOut = Sheets("Sheet1").Range("F1") 'first cell for output
For Each c In rIn
If c <> "" Then 'not blank so populate output
Range(rOut, rOut.Offset(, 2)) = Array(c.Address, c.Column - 1, c.Row - 1)
Set rOut = rOut.Offset(1, 0) 'next row
End If
Next c
End Sub
I need to create a macro that would look at every cells only in a specific column (i.e. not the whole spreadsheet) and starting at a specific row. Then, it would have all rows that does not contain my value of interests.
Lets say for example my goal is to search every value in column "A" and I'll filter from A2 to A99999999, leaving A1 untouched.I would then delete every row that does not contain 103526 and 103527 in column A.
The following code is able to filter through all the rows for my values of interest, however, I am having trouble filtering only ONE column and from A2 to A99999999. How can I change this code to meet those conditions?
Sub test()
Dim j As Integer, k As Integer
Dim r As Range, cfind6 As Range, cfind7 As Range
Worksheets("sheet1").Activate
On Error Resume Next
j = Cells(Rows.Count, "A").End(xlUp).Row
For k = j To 1 Step -1
Set cfind6 = Rows(k).Cells.Find(what:=103526, lookat:=xlWhole)
Set cfind7 = Rows(k).Cells.Find(what:=103527, lookat:=xlWhole)
If cfind6 Is Nothing And cfind7 Is Nothing Then Rows(k).Delete
Next
There are a couple of different ways to approach this, one way would be to change your code to something like:
Sub test()
Dim i As Integer
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Not (ws.Cells(i, 1).Value = 103526 Or ws.Cells(i, 1).Value = 103527) Then
ws.Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub