I'm wanting to clear a cell contents of a range based.
I think I'm nearly there.
Dim R As Range
Dim myRange As Range
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Set myRange = Range("Y2:Y" & LastRow)
For Each R In myRange
If R = 0 Then
cell.ClearContents
End If
Next
End Sub
All help appreciated.
The problem is your cell reference. Change cell. to R. R is the cell in the range that you are looping through so if R = 0, clear it.
Sub clearR()
Dim R As Range
Dim myRange As Range
lastRow = Range("A" & rows.count).End(xlUp).Row
Set myRange = Range("Y2:Y" & lastRow)
For Each R In myRange
If R = 0 Then
R.ClearContents
End If
Next
End Sub
Another Solution without a loop if column Y is not formula then this should work.
Sub clearR()
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("Y2:Y" & LastRow).Replace 0, "", xlWhole
End Sub
You could use:
Sub Macro1()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
'Find last row
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'Clear replace 0 with nothing in the specific range
.Range("Y2:Y" & LastRow).Replace What:="0", Replacement:="", LookAt:=xlWhole
End With
End Sub
Related
So I have to loop through a range of about 10000 cells containing strings and shortening them to 255 characters. My actual code is like this:
For i = firstRow to lastRow
Range("X" & i) = Left(Range("X" & i),255)
Next i
However, this is extremely slow, so I was wondering if there was anyway to do that once on the whole range instead of looping through each cell of the range, or if there was any other way that is more efficient than doing it my way.
Try this:
Sub short()
Dim arr, FirstRow As Long, LastRow As Long, i As Long
arr = ThisWorkbook.Sheets("yoursheetname").Range("X" & FirstRow, "X" & LastRow).Value
For i = 1 To UBound(arr)
arr(i, 1) = Left(arr(i, 1), 255)
Next i
ThisWorkbook.Sheets("yoursheetname").Range("X" & FirstRow, "X" & LastRow).Value = arr
End Sub
When you work with thousands of rows or cells, arrays are the best way to go.
You try:
Option Explicit
Sub test()
Dim Lastrow As Long, FirstRow, i As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "X").End(xlUp).Row
FirstRow = 1
For i = FirstRow To Lastrow
.Range("X" & i).Value = Left(.Range("X" & i).Value, 255)
Next i
End With
End Sub
Or
Option Explicit
Sub test()
Dim Lastrow As Long, FirstRow
Dim rng As Range, cell As Range
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "X").End(xlUp).Row
FirstRow = 1
Set rng = .Range(.Cells(FirstRow, 24), Cells(Lastrow, 24))
For Each cell In rng
cell.Value = Left(cell.Value, 255)
Next cell
End With
End Sub
Or this:
With ActiveSheet.Range("X" & firstRow & ":X" & lastRow)
.Value = .Parent.Evaluate("LEFT(" & rng.Address & ",255)")
End With
How to delete the values which are not followed by second immediate cell?
Following might help.
Sub Demo()
Dim ws As Worksheet
Dim lastRow As Long
Dim cel As Range
Set ws = ThisWorkbook.Sheets("Sheet5") 'change Sheet5 to your data sheet
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Each cel In .Range("B1:B" & lastRow)
If IsEmpty(cel) Then 'or use If Len(cel) = 0 Then
cel.Offset(0, -1).ClearContents
End If
Next cel
End With
End Sub
If you want to delete the rows where Column B is empty then try this
Sub Demo()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet5") 'change Sheet5 to your data sheet
ws.Range("B1:B100").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'change range as per your data
End Sub
Use this macro. Enter it in regular module (eq Module 1). it will remove all values in column A in case there is no value in adjacent cell in column B.
Sub delete()
For x = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Range("B" & x).Value <> "" Then
Else
Range("A" & x).ClearContents
End If
Next x
End Sub
or if you want to delete those rows.
Sub deleteRows()
For x = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Range("B" & x).Value <> "" Then
Else
Range("A" & x).EntireRow.delete
End If
Next x
End Sub
I have a Sheet with columns A through F. I'm looking for the program to run through all the rows (Is there a way for it to only do active rows?) and check if D1 & E1 & F1 are blank, then hide the row (and so on).
Here's what I have which doesn't really work too well....
Sub Celltest2()
Dim rw As Range, cel As Range
Dim i As Integer
Dim celset As Range
For Each rw In Sheets("Phonelist").Range("D2:F5000").Rows
For Each cel In rw.Cells
If Len(cel.Text) = 0 Then
cel.EntireRow.Hidden = True
End If
Next
Next
End Sub
Try the code below:
Sub Celltest2()
Dim rw As Range, cel As Range
Dim i As Integer
Dim celset As Range
Dim LastRow As Long
With Sheets("Phonelist")
' find last row with data in Columns "D, "E" and "F" >> modify to your needs
LastRow = WorksheetFunction.Max(.Cells(.Rows.Count, "D").End(xlUp).Row, _
.Cells(.Rows.Count, "E").End(xlUp).Row, _
.Cells(.Rows.Count, "F").End(xlUp).Row)
For Each rw In .Range("D2:F" & LastRow).Rows
If WorksheetFunction.CountA(Range("D" & rw.Row & ":F" & rw.Row)) = 0 Then
rw.EntireRow.Hidden = True
End If
Next rw
End With
End Sub
Option 2: You can replace the loop above (the one that starts with For Each rw In .Range("D2:F" & LastRow).Rows) with the following loop:
For i = 2 To LastRow
If WorksheetFunction.CountA(Range("D" & i & ":P" & i)) = 0 Then
Rows(i).EntireRow.Hidden = True
End If
Next i
I am tring to alter this code FindReplace_With_Offset_1 to FindReplace_With_Offset_2
FindReplace_With_Offset_1 Run on a Col Range and it works fine
I need FindReplace_With_Offset_2 to run only on each Cell in the Col Range i.e. I need each cell to be its own range, when I run it I get #NAME? for every Cell with value #N/A
Thanks
Sub FindReplace_With_Offset_1()
Dim wsFR As Worksheet, wsT As Worksheet
Dim tLR As Long, i As Long
Set wsT = ThisWorkbook.Worksheets("XXX")
Set wsFR = ThisWorkbook.Worksheets("ZZZ")
With wsT
tLR = .Range("C" & .Rows.Count).End(xlUp).Row
With .Range("B2:B" & tLR) 'The Offset Range
.Value = _
"=VLOOKUP(D2," & wsFR.Range("D1").CurrentRegion.Address(1, 1, , 1) & ",2,0)"
.Value = .Value
End With
End With
End Sub
Code2
Sub FindReplace_With_Offset_2()
Dim wsFR As Worksheet, wsT As Worksheet
Dim Rng As Range, aCell As Range
Dim tLR As Long, i As Long
Set wsT = ThisWorkbook.Worksheets("XXX")
Set wsFR = ThisWorkbook.Worksheets("ZZZ")
With wsT
tLR = .Range("C" & .Rows.Count).End(xlUp).Row
Set Rng = .Range("A2:A" & tLR)
For Each aCell In Rng
If aCell.text = "#N/A" Then
aCell.Value = _
"=VLOOKUP(aCell," & wsFR.Range("C1").CurrentRegion.Address(1, 1, , 1) & ",2,0)"
aCell.Value = aCell.Value
Else
aCell = aCell
End If
Next aCell
End With
End Sub
Maybe it's because you're trying to put the code to read a error value, and for the excel the cell value isn't the text "#N/A", try to use the IfError formula to run the verification on the desired cell, like this:
If WorksheetFunction.IfError(aCell,"Error") = "Error" Then
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