I am very new to VBA and just beginning to learn. I have a code here to match all the cells of the "M" column in Sheet1 and Sheet3, and delete all the rows from Sheet1 that contain any value from Sheet3's "M" column.
If I go through it using F8, I do not get any error but when I assign it to a button, it fails at run-time with 'Object Required' error. I tried a few things that I found online, but none of them seem to work.
Below is my code. Any help would be much appreciated.
Sub DeleteRows()
Dim rng As Range
Dim rng2 As Range
Dim cell As Object
Dim cell2 As Object
Set rng = Sheets("Sheet1").Range("M2:M1541")
Set rng2 = Sheets("Sheet3").Range("M2:M30")
For Each cell In rng
For Each cell2 In rng2
If cell.Value = cell2.Value Then
cell.EntireRow.Delete
End If
Next
Next
Application.ScreenUpdating = True
End Sub
Thanks in advance!
You can loop through the cells in sheet2 and filter for those items in sheet1.
Then you would not be double looping.
Sub Button1_Click()
Dim ws As Worksheet, sh As Worksheet
Dim LstRw As Long, Rng As Range, Frng As Range, c As Range, Nrng As Range
Set ws = Sheets("Sheet2")
Set sh = Sheets("Sheet1")
With ws
LstRw = .Cells(.Rows.Count, "M").End(xlUp).Row
Set Rng = .Range("M2:M" & LstRw)
End With
With sh
Set Frng = .Range("M2:M" & .Cells(.Rows.Count, "M").End(xlUp).Row)
For Each c In Rng.Cells
.Range("M1").AutoFilter Field:=1, Criteria1:=c
On Error Resume Next
Set Nrng = Frng.SpecialCells(xlVisible)
On Error GoTo 0
If Nrng Is Nothing Then
Else
Frng.EntireRow.Delete
End If
Next c
.AutoFilterMode = False
End With
End Sub
Related
I need to hide visible duplicate cells in a range.
With using AdvancedFilter, yes it hides the duplicate cells (entire row) But It also show all the hidden rows in the respective range.
I tried to use SpecialCells(xlCellTypeVisible) method, But I got the following error:
Run-time error '1004': Database or table range is not valid.
If it is not applicable to use AdvancedFilter, What are the other possible methods?
As always, gratfull for all your help.
Sub Hide_Visible_Duplicate_Cells()
Dim ws As Worksheet, arng As Range, LastR As Long
Set ws = ThisWorkbook.ActiveSheet
LastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set arng = ws.Range("A1:A" & LastR)
arng.SpecialCells(xlCellTypeVisible).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=arng, Unique:=True
End Sub
Please, try the next adapted code. It uses a dictionary to detect which rows to be hidden (only after the dictionary key has been created) and set a Union range for the respective cells. Finally, EntireRow of this range will be hidden:
Sub Hide_Visible_Duplicate_Cells()
Dim ws As Worksheet, arng As Range, LastR As Long
Dim C As Range, UnRng As Range, dict As New Scripting.Dictionary
Set ws = ThisWorkbook.ActiveSheet
LastR = ws.Range("A" & ws.rows.count).End(xlUp).row
On Error Resume Next 'just for the (improbable) case when no cell exist in the respective range
Set arng = ws.Range("A1:A" & LastR).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If arng Is Nothing Then Exit Sub
For Each C In arng.cells
If Not dict.Exists(C.Value) Then
dict.Add C.Value, vbNullString 'keep the first occurrence
Else
addToRange UnRng, C 'create a Union range for the next occurrences
End If
Next C
'hide the rows at once:
If Not UnRng Is Nothing Then UnRng.EntireRow.Hidden = True
End Sub
Sub addToRange(rngU As Range, rng As Range) 'Add to the Union range...
If rngU Is Nothing Then
Set rngU = rng
Else
Set rngU = Union(rngU, rng)
End If
End Sub
Please, send some feedback after testing it.
Edited:
The next suggested solution can be called from another Sub:
Sub Hide_Visible_Dup_Cells(procRng As Range)
Dim arng As Range, C As Range, UnRng As Range, dict As Object
On Error Resume Next
Set arng = procRng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If arng Is Nothing Then Exit Sub
Set dict = CreateObject("Scripting.Dictionary") 'no need of reference...
For Each C In arng.cells
If Not dict.Exists(C.Value) Then
dict.Add C.Value, vbNullString
Else
addToRange UnRng, C
End If
Next C
If Not UnRng Is Nothing Then UnRng.EntireRow.Hidden = True
End Sub
For the above case, it can be called as:
Sub tesHide_Visible_Dup_Cells()
Dim ws As Worksheet, rng As Range, LastR As Long
Set ws = ThisWorkbook.ActiveSheet
LastR = ws.Range("A" & ws.rows.count).End(xlUp).row
Set rng = ws.Range("A1:A" & LastR)
Hide_Visible_Dup_Cells rng
End Sub
Need your help to get same objective to fill up the "null" value faster than below script .
Sub FillEmptyCell()
Dim rng As Range
Dim i As Long
Dim cell As Range
Dim sht As Worksheet
Set sht = ActiveWorkbook.Sheets("rawdata")
sht.Activate
Set rng = Range(Range("G2:G14614"), Range("G" & sht.UsedRange.Rows.Count))
For Each cell In rng
If cell.Value = "" Then cell.Value = "BLANKON"
Next
End Sub
Try,
Sub FillEmptyCell()
with workSheets("rawdata")
with .range(.cells(2, "G"), .cells(.rows.count, "G").end(xlup))
on error resume next
.specialcells(xlcelltypeblanks) = "BLANKON"
on error goto 0
end with
.Activate
end with
End Sub
Sub iterateThroughAll()
ScreenUpdating = False
Dim wks As Worksheet
Set wks = ActiveSheet
Dim rowRange As Range
Dim colRange As Range
Dim LastCol As Long
Dim LastRow As Long
LastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
Set rowRange = wks.Range("A1:A" & LastRow)
'Loop through each row
For Each rrow In rowRange
'Find Last column in current row
LastCol = 1 'wks.Cells(rrow, wks.Columns.Count).End(xlToLeft).Column
Set colRange = wks.Range(wks.Cells(rrow, 1), wks.Cells(rrow, LastCol)) <-------------- I get a Run-time error 1004 Application defined or object defined error.
'Loop through all cells in row up to last col
For Each cell In colRange
'Do something to each cell
Debug.Print (cell.Value)
Next cell
Next rrow
ScreenUpdating = True
End Sub
I get an Application-defined or object-defined error. The code looks okay but not sure why its not working here.
I am trying to get all the used cells in Column A
Option Explicit
Sub iterateThroughAll()
Application.ScreenUpdating = False
Dim wks As Worksheet
Set wks = ActiveSheet
Dim rowRange As Range, rrow As Range
Dim colRange As Range, Cell As Range
Dim LastCol As Long
Dim LastRow As Long
LastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
Set rowRange = wks.Range("A1:A" & LastRow)
'Loop through each row
For Each rrow In rowRange
'Find Last column in current row
LastCol = 1 'wks.Cells(rrow, wks.Columns.Count).End(xlToLeft).Column
Set colRange = wks.Range(wks.Cells(rrow.Row, 1), wks.Cells(rrow.Row, LastCol))
'Loop through all cells in row up to last col
For Each Cell In colRange
'Do something to each cell
Debug.Print (Cell.Value)
Next Cell
Next rrow
Application.ScreenUpdating = True
End Sub
Sub FillEmptyCell()
Dim rng As Range
Dim i As Long
Dim cell As Range
Dim sht As Worksheet
Set sht = ActiveWorkbook.Sheets("Sheet1")
sht.Activate
Set rng = Range(Range("C12"), Range("AD" & sht.UsedRange.Rows.Count))
For Each cell In rng
If cell.Value = "" Then
cell.Value = "0"
End If
Next
End Sub
I am trying to fill my blank spaces in sheet with zero dynamically.However,
I don't want this to fill zeroes in row that have no data. can someone help please?
See how this works,
Sub ZeroStuff()
Dim LstRw As Long, rng As Range, sh As Worksheet, c As Range
Set sh = Sheets("Sheet1")
With sh
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
Set rng = .Range("C12:C" & LstRw).SpecialCells(xlCellTypeBlanks)
For Each c In rng.Cells
.Range(c.Offset(, 1), c.Offset(, 27)) = 0
Next c
End With
End Sub
I am new to VBA.
For each cell in columns("c:c")
If cell.value = "TRUE" Then
'vba is required for selecting corresponding cells in columns A and B
Next cell
Else:
exit sub
End if
end sub
please make suitable corrections
Try this one:
Sub test()
Dim lastrow As Long
Dim c As Range, rng As Range
'change Sheet1 to suit
With ThisWorkbook.Worksheets("Sheet1")
lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
For Each c In .Range("C1:C" & lastrow)
If UCase(c.Text) = "FALSE" Then
If rng Is Nothing Then
Set rng = .Range("A" & c.Row).Resize(, 2)
Else
Set rng = Union(rng, .Range("A" & c.Row).Resize(, 2))
End If
End If
Next c
End With
If Not rng Is Nothing Then rng.Select
End Sub