The below code works fine to find the first empty cell in a given column (here column B). But what I need is a code to find the first blank cell in that column.
Sub macro1()
Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim currentRowValue As String
sourceCol = 2 'column B has a value of 2
rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row
'for every row, find the first blank cell and select it
For currentRow = 1 To rowCount
currentRowValue = Cells(currentRow, sourceCol).Value
If IsEmpty(currentRowValue) Or currentRowValue = "" Then
Cells(currentRow, sourceCol).Select
End If
Next
End Sub
Also, it should start looking from row 10 instead of row 1.
Can somebody rewrite this code to do this?
Could something like this be what you're looking for:
Sub test()
Dim ws As Worksheet
Set ws = ActiveSheet
For Each cell In ws.Columns(2).Cells
If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
End Sub
This will run through each cell in column B in the active worksheet and select the first empty one it comes across. To set the sheet to a particular one Change Set ws = ActiveSheet to Set ws = Sheets("EnterSheetNameHere")
Or you could try using:
Sub test()
Dim ws As Worksheet
Set ws = ActiveSheet
For Each cell In ws.Columns(2).Cells
If Len(cell) = 0 Then cell.Select: Exit For
Next cell
End Sub
My problem is solved by using the following code.
Sheets("sheet1").Select
Dim LR2 As Long, cell2 As Range, rng2 As Range
With Sheets("sheet1")
LR2 = .Range("B" & Rows.Count).End(xlUp).Row
For Each cell2 In .Range("B8:B" & LR2)
If cell2.Value <> "" Then
If rng2 Is Nothing Then
Set rng2 = cell2
Else
Set rng2 = Union(rng2, cell2)
End If
End If
Next cell2
rng2.Select
End With
Just my two cents.
The function will look for the first encountered BLANK cell in a range, so it should work with columns and rows.
'Find first BLANK cell in a given range, returnt a range (one cell)
Function FirstBlank(ByVal rWhere As Range) As Range
Dim vCell As Variant
Dim answer As Range
Set answer = Nothing
For Each vCell In rWhere.Cells
If Len(vCell.Formula) = 0 Then
Set answer = vCell
Exit For
End If
Next vCell
Set FirstBlank = answer
End Function
And then do whatever you want with the cell.
Try this code to select the first empty cell below cell B10. But it requires B10 and B11 to be pre-occupied.
Range("B10").End(xlDown).Offset(1, 0).Select
or
Range("B100000").End(xlUp).Offset(1, 0).Select
Related
I was writing a program for deleting a row in a Selection with Empty Cell. I wrote the code and it worked well but it have a deficiency.
Code Is:
Dim i As Integer
Dim j As Integer
Dim Num As Integer
Num = Selection.Cells.Count
'MsgBox ("Num of Cells " & Num)
Selection.End(xlUp).Select
If (IsEmpty(ActiveCell)) Then
Selection.End(xlDown).Select
End If
For i = 1 To Num
If (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(-1, 0).EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
Num = Num - 1
On Error GoTo Last
Else
ActiveCell.Offset(1, 0).Select
End If
Next
Last:
Exit
Now I was trying to rewrite the code with looping the cell in Range instead of above For loop:
Dim i As Integer
Dim j As Integer
Dim Num As Integer
Dim myRange As Range
ActiveSheet.Select
Set myRange = Selection.Cells
For Each myRange In Selection
If (IsEmpty(myRange)) Then
ActiveCell.EntireRow.Delete
On Error GoTo Last
Else
'ActiveCell.Offset(1, 0).Select
End If
Next myRange
Last:
Exit
This piece of code is not working Properly. Kindly put your Suggestions and rectify the Code
you could try
If WorksheetFunction.CountBlank(Selection) > 0 Then Intersect(Selection.SpecialCells(xlCellTypeBlanks).EntireRow, Selection.Columns(1)).EntireRow.Delete
Speciealcells seems to be easy to use.
Sub test()
Dim rngDB As Range
Set rngDB = Selection
On Error Resume Next
Set rngDB = rngDB.SpecialCells(xlCellTypeBlanks)
If Err.Number = 0 Then
rngDB.EntireRow.Delete
End If
End Sub
Here is an option that avoids relying on Selection and Select.
You can use a InputBox to determine the range. This will allow you to properly qualify all of your ranges/worksheets. You can then loop through the selected range and determine if the rows should be deleted (if blank).
At the end, delete all the rows at once. On larger operations, this will be much faster since you will only have 1 instance of deletion rather continuously deleting rows in the loop.
Option Explicit
Sub Blanks()
Dim MyRange As Range, MyCell As Range, DeleteMe As Range
Set MyRange = Application.InputBox("Select Range", Type:=8)
For Each MyCell In MyRange
If MyCell = "" Then
If DeleteMe Is Nothing Then
Set DeleteMe = MyCell
Else
Set DeleteMe = Union(DeleteMe, MyCell)
End If
End If
Next MyCell
If Not DeleteMe Is Nothing Then DeleteMe.EntireRow.Delete
End Sub
I need VBA code that will open Workbook2 depending on value of a cell in Workbook1 (A1).
In B:B column (Workbook1) there are values, if these values are the same as those available in A:A column (Workbook2) delete entire row that contains the same values in (Workbook2).
Can anyone help me to create the code?
i tried this one .....
Private Sub CommandButton1_Click()
Dim WB1, WB2 As Workbook
Dim WS1, WS2 As Worksheet
Set WB1 = ThisWorkbook
CSN = Cells(1, 1)
Set WB2 = Workbooks.Open("C:\Users\Basel\Desktop\" & CSN & "")
Set WS1 = WB1.Worksheets("sheet1")
Set WS2 = WB2.Worksheets("Sheet1")
LastRow1 = WB1.WS1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
LastRow2 = WB2.WS2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To 20
If WB1.WS1.Cells(i, 2).Value = WB2.WS2.Cells(i, 1).Value Then
WB2.WS2.Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub
Assuming the following:
1) you have created two workbook objects called WorkBook1 and WorkBook2
2) you are comparing column "A" in both books with the sheet called "sheet1"
Dim WB1sheet As Worksheet
Dim WB2sheet As Worksheet
Dim cell As Range
Dim cell2 As Range
Set WB1sheet = WorkBook1.Sheets("sheet1")
Set wb2sheet = Workbook2.Sheets("sheet1")
'Loop through colum A
For Each cell In WB1sheet.Range("a1", "a1000000")
' for each loop through the other sheet
If cell = "" Then
Exit For
End If
For Each cell2 In wb2sheet.Range("a1", "a1000000")
If cell = cell2 Then
cell2.ClearContents
Exit For
End If
Next cell2
Next cell
End Sub
This will just leave a blank cell not delete the row, it is more tricky to delete the row because the for each loop will get out of sink and miss rows.
If you need the row removed not just cleared then the easy fix is to do a sort on the column afterwards and the blanks will all move to the bottom. Just record the sort using macro record.
Good luck
thanks really i made some modification on the code but it works.
Private Sub CommandButton1_Click()
Dim WB1, WB2 As Workbook
Dim WS1, WS2 As Worksheet
Dim CELL1 As Range
Dim CELL2 As Range
CSN = Cells(1, 1)
Set WB1 = ThisWorkbook
Set WB2 = Workbooks.Open("C:\Users\Basel\Desktop\" & CSN & "")
Set WS1 = WB1.Worksheets("sheet1")
Set WS2 = WB2.Worksheets("Sheet1")
For Each CELL1 In WS1.Range("B1", "B10")
If CELL1 = "" Then
Exit For
End If
For Each CELL2 In WS2.Range("A1", "A10")
If CELL1 = CELL2 Then
CELL2.EntireRow.Delete
Exit For
End If
Next CELL2
Next CELL1
WB2.Save
WB2.Close
Range("B:B").ClearContents
End Sub`
`
Newbie at vba here. I'm trying to apply a simple For Each loop (which nullifies cells < 0) to all worksheets in the workbook by nesting this inside another For Each loop.
When I try and run my code below I get an error and I'm not sure if it has anything to do with having worksheet as a variable within a Set statement.
Can't seem to figure this out/find a solution.
Thanks
Sub deleteNegativeValue()
Application.DisplayAlerts = False
Dim lastRow As Long
Dim ws As Worksheet
Dim cell As Range
Dim res As Range
For Each ws In Workbooks(1).Worksheets
Set res = ws.Range("1:1").Find("Value", lookat:=xlPart)
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Range(ws.Cells(1, res.Column), ws.Cells(lastRow, res.Column))
If cell < 0 Then cell = ""
Next
Next
End Sub
Try this:
Sub deleteNegativeValue()
Dim lastRow As Long
Dim ws As Worksheet
Dim cell As Range
Dim res As Range
For Each ws In ThisWorkbook.Worksheets
Set res = ws.Range("1:1").Find("Value", lookat:=xlPart)
lastRow = ws.Range("A" & Rows.Count).End(xlUp).row
If Not res Is Nothing Then
For Each cell In ws.Range(ws.Cells(1, res.Column), ws.Cells(lastRow, res.Column))
If cell < 0 Then cell = ""
Next
Else
MsgBox "No Value found on Sheet " & ws.Name
End If
Next
End Sub
There needs to be a check on the Find method, to ensure that something was found
you could try this
Option Explicit
Sub deleteNegativeValue()
Dim ws As Worksheet
Dim res As Range
For Each ws In ThisWorkbook.Worksheets
Set res = Intersect(ws.Rows(1), ws.UsedRange).Find("value", LookAt:=xlPart)
If Not res Is Nothing Then
ws.Columns(res.Column).SpecialCells(xlCellTypeConstants, xlNumbers).Replace What:="-*", Replacement:="", SearchOrder:=xlByColumns, MatchCase:=False, LookAt:=xlWhole
Else
MsgBox "No Value found on Sheet " & ws.Name
End If
Next
End Sub
which should run faster since it doesn't iterate through every cell of each column and restrict the Find method range to the used one instead of the entire row.
the only warning is that the first row of all searched in sheets must not be empty...
Try the second for-each this way:
ws.Range(ws.Cells(1, res.Column), ws.Cells(lastRow, res.Column))
I've written some simple code that matches cells in one worksheet to cells in another, and then deletes the entire row if the cells are equal.
The code selects rows properly, but for some reason refuses to actually delete the rows in my worksheet. EDIT: Some of the rows delete. Others don't, even though they have the exact same values as those that did delete. If anyone can help that would be greatly appreciated.
Sub delFunds()
Dim fCell As Range 'Fund cell
Dim fRng As Range 'Fund range
Dim wCell As Range 'Working sheet cell
Dim wRng As Range 'Working sheet range
Dim n As Long
Set fRng = Worksheets("Funds").Range("C2:C117")
Set wRng = Worksheets("Working sheet").Range("I3:I7483")
For Each fCell In fRng.Cells 'Loop through all funds
For Each wCell In wRng.Cells 'Loop through all working cells
If StrComp(wCell.Value, fCell.Value, vbTextCompare) = 0 Then 'If equal then delete
n = wCell.Row
Rows(n & ":" & n).Select
Selection.Delete Shift:=xlUp
End If
Next wCell
Next fCell 'Go to next fund
End Sub
I would use this code without nested loop:
Sub delFunds()
Dim rngToDel As Range
Dim fRng As Range 'Fund range
Dim wCell As Range 'Working sheet cell
Dim wRng As Range 'Working sheet range
Set fRng = Worksheets("Funds").Range("C2:C117")
Set wRng = Worksheets("Working sheet").Range("I3:I7483")
For Each wCell In wRng 'Loop through all working cells
' if wCell found in Fund range then delete row
If Not IsError(Application.Match(Trim(wCell.Value), fRng, 0)) Then
If rngToDel Is Nothing Then
Set rngToDel = wCell
Else
Set rngToDel = Union(rngToDel, wCell)
End If
End If
Next wCell
If Not rngToDel Is Nothing Then rngToDel.EntireRow.Delete
End Sub
I know #simoco's answer works and has been accepted already, but I love a good question so I wanted to pull together a solution using the autofilter to kill big swaths of the working sheet at once. I figured your design might look like this:
From there, you can loop through the concise fund list and filter the working sheet on each fund:
Option Explicit
Sub EliminateWorkingDuplicates()
Dim WorkingSheet As Worksheet, FundSheet As Worksheet
Dim FundRange As Range, WorkingRange As Range, _
Fund As Range
Dim LastRow As Long, LastCol As Long, _
WorkingFundCol As Long
'assign sheets and ranges for easy reference
Set WorkingSheet = ThisWorkbook.Worksheets("Working sheet")
Set FundSheet = ThisWorkbook.Worksheets("Funds")
Set FundRange = FundSheet.Range("C2:C117")
WorkingFundCol = 9 'column I on working sheet
'determine the bounds of the data block on the working sheet
LastRow = WorkingSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = WorkingSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set WorkingRange = Range(WorkingSheet.Cells(2, 1), WorkingSheet.Cells(LastRow, LastCol))
'start working through the funds and calling the autofilter function
For Each Fund In FundRange
Call FilterAndDeleteData(WorkingRange, WorkingFundCol, Fund.Value)
Call ClearAllFilters(WorkingSheet)
Next Fund
End Sub
'**********
'blow away rows
Sub FilterAndDeleteData(DataBlock As Range, TargetColumn As Long, Criteria As String)
'make sure some joker didn't pass in an empty range
If DataBlock Is Nothing Then Exit Sub
'execute the autofilter with the supplied column and criteria
With DataBlock
.AutoFilter Field:=TargetColumn, Criteria1:=Criteria
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub
'**********
'safely clear filters
Sub ClearAllFilters(TargetSheet As Worksheet)
With TargetSheet
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData
End If
End With
End Sub
This is what I have already, and it works great in removing #N/As from the range. I am now looking to modify it to do the same thing for cells that contain 0.
Sub DeleteErrorRows()
Dim r As Range
Set r = Range("B:B").SpecialCells(xlCellTypeConstants, 16).EntireRow
r.Copy Sheets("Sheet2").Range("A1")
r.Delete
End Sub
Thanks :)
Try this. It autofilters your column and keeps rows that have the findMe value in your source worksheet. You can set it to 0 as I have in the example or to whatever else you want. It copies those rows (except for the header row) to the target sheet and then deletes them from the source sheet.
Note that this also finds the first empty row on the target sheet so that you can run it multiple times without overwriting what you've already moved to the target sheet.
Sub CopyThenDeleteRowsWithMatch()
Dim wb As Workbook
Dim ws As Worksheet
Dim tgt As Worksheet
Dim rng As Range
Dim lastRow As Long
Dim firstPasteRow As Long
Dim findMe As String
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set tgt = wb.Sheets("Sheet2")
lastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
firstPasteRow = tgt.Range("B" & tgt.Rows.Count).End(xlUp).Row + 1
findMe = "0"
Set rng = ws.Range("B1:B" & lastRow)
' filter and delete all but header row
With rng
.AutoFilter Field:=1, Criteria1:="=" & findMe
With .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
.Copy tgt.Range("A" & firstPasteRow)
.Delete
End With
End With
' turn off the filters
ActiveSheet.AutoFilterMode = False
End Sub
Consider:
Sub DeleteZeroRows()
Dim r As Range, rTemp As Range, rB As Range
Set rB = Intersect(Range("B:B"), ActiveSheet.UsedRange)
Set r = Nothing
For Each rTemp In rB
If Not IsEmpty(rTemp) And rTemp.Value = 0 Then
If r Is Nothing Then
Set r = rTemp
Else
Set r = Union(r, rTemp)
End If
End If
Next rTemp
Set r = r.EntireRow
r.Copy Sheets("Sheet2").Range("A1")
r.Delete
End Sub