I have a spreadsheet with letter "D" and nothing else put in random cells. What code do I use to select/copy - or even better dim as range - all of those cells?
So far I Have the following:
Sub SelectD()
Dim AllD As Range
For Each cell In ActiveSheet.UsedRange.Cells
If cell = "D" Then
Set AllD = '???
End If
Next cell
End Sub
Thanks,
Bartek
Use Union to add the cells to the range as they are found.
Sub SelectD()
Dim AllD As Range
For Each cell In ActiveSheet.UsedRange.Cells
If cell = "D" Then
If AllD Is Nothing then
Set AllD = cell
Else
Set AllD = Union(cell,AllD)
End If
End If
Next cell
'Do something with AllD
Debug.Print AllD.Address
End Sub
Related
I'm trying to round every populate cell in column AD:AD to 4 decimals and ends when the next cell is blank.
I thought something like this would work but it errors out on the cell.value.
Sub Round_4()
For Each cell In [AD:AD]
If cell = "" Then Exit Sub
cell.Value = WorksheetFunction.Round(cell.Value, 4)
Next cell
End Sub
Any suggestions?
You could work only down to the first empty cell with
Range("AD1", Range("AD1").End(xlDown)).Value = Evaluate("round(" & Range("AD1", Range("AD1").End(xlDown)).Address & ",4)")
Note this is using Activesheet reference. You can wrap in a With statement giving the parent sheet.
You could do this:
Dim myCell As Range
Dim myRange As Range
Set myRange = Excel.Application.ThisWorkbook.Worksheets(worksheetNameGoesHereInDoubleQuotes).Range("AD:AD")
For Each myCell In myRange
If Not IsEmpty(myCell) Then
myCell.Value = Application.WorksheetFunction.Round(CDbl(myCell.Value), 4)
'me being lazy with my range assignment
ElseIf IsEmpty(myCell) Then
Exit For
End If
Next
I'm trying to copy and paste the cells in each row C through F if the value in column C is greater than 0. Please help thanks!
Private Sub CommandButton2_Click()
Dim range1 As Range
Dim Cell As Object
Set range1 = Sheet1.Range("C8:C40")
For Each Cell In range1
If IsEmpty(Cell) Then
End If
If Cell.Value > 0 Then
Sheet1.range(C:F).Copy
Sheet5.Select
ActiveSheet.Range("A40").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
You need to set the row that is being tested.
Also do not use .Activate or .Select It only slows down the code.
Private Sub CommandButton2_Click()
Dim range1 As Range
Dim Cell As Range
Set range1 = Sheet1.Range("C8:C40")
For Each Cell In range1
If Cell.Value > 0 Then
With Sheet1
.Range(.Cells(Cell.Row,"C"),.Cells(Cell.Row,"F")).Copy Sheet5.Range("A40").End(xlUp).Offset(1, 0)
End With
End If
Next
End Sub
To do it with just the values, no formatting, Change this:
.Range(.Cells(Cell.Row,"C"),.Cells(Cell.Row,"F")).Copy Sheet5.Range("A40").End(xlUp).Offset(1, 0)
To:
Sheet5.Range("A40").End(xlUp).Offset(1, 0).Resize(,4).Value = .Range(.Cells(Cell.Row,"C"),.Cells(Cell.Row,"F")).Value
I have the following code and it works well, however, I'd like to loop through a cell range and name the cells in the range with the cell value:
Sub NameCell()
Range("A2").Name = Range("A2").Value
End Sub
Give this a try:
Sub NameMaker()
For Each r In Selection
With r
.Name = .Value
End With
Next r
End Sub
I would like some support in correcting this simple piece of code. when running the code it is always displaying 1 and then a miss match error box pops up. I cant see why this is not working the code seems simple enough.
Sub Test3()
Dim rng As Range, cell As Range
Set rng = Range("D1:D10")
For Each cell In rng
If cell.Value > 0 Then
MsgBox Application.WorksheetFunction.CountA(cell.Value)
End If
Next cell
End Sub
Here is one way:
Sub Test3()
Dim rng As Range, cell As Range, IAmTheCount As Long
Set rng = Range("D1:D10")
IAmTheCount = 0
For Each cell In rng
If cell.Value > 0 Then
IAmTheCount = IAmTheCount + 1
End If
Next cell
MsgBox IAmTheCount
End Sub
Since you are using a for each loop, you are counting the cells one by one. That's why the Msgbox always says 1. You should not use a loop to achieve what you want
Sub Test3()
Dim rng As Range, cell As Range
Set rng = Range("D1:D10")
MsgBox Application.WorksheetFunction.CountIf(rng, ">0")
End Sub
Hi I am trying to run the following vb code on my spreadsheet but I am getting an error during the Randge that there is a data type mismatch. I am just trying to lock the cells where the value is 0. There are some cells with #NA values Any ideas?
Sub Test()
Dim Cell As Range
Set MyPlage = Range("J6:J1074")
For Each Cell In MyPlage.Cells
If Not IsError(Cell) Then
If Range("J6:J1074").Value = "0" Then
Range("J6:J1074").Locked = True
End If
End If
Next
End Sub
Try this one:
Sub Test()
Dim Cell As Range
Dim MyPlage As Range
With ThisWorkbook.ActiveSheet
.Unprotect
.Cells.Locked = False
Set MyPlage = .Range("J6:J1074")
For Each Cell In MyPlage
If Not IsError(Cell) Then
If Cell.Value = "0" Then
Cell.Locked = True
End If
End If
Next
.Protect
End With
End Sub
BTW, it's better to change ActiveSheet to Worksheets("SheetName")