I want to convert to upper case a selected range in Excel.
Here's my code
Dim rng As Range
Set rng = Selection
rng.Value = rng.Parent.Evaluate("INDEX(UPPER(" & rng.Address & "),)")
It works on a large range, but gives the #VALUE! error when only a single cell is selected.
Cut your selection down to the used range in case you have selected an entire column or row.
Process a single cell if you only have a single cell selected; process in bulk for any multiple cell selections.
Dim rng As Range
Set rng = Intersect(Selection, Selection.Parent.UsedRange)
If rng.Cells.Count > 1 Then
rng.Value = Application.Evaluate("INDEX(UPPER(" & rng.Address & "),)")
Else
rng = UCase(rng.Value)
End If
This code will work for single cell or a selection:
Sub ChangeCellCase()
Dim CellCase
For Each CellCase In Selection
CellCase.Value = UCase(CellCase.Value)
Next
End Sub
Related
the aim of my problem is to find a specific value (Text) and then refer to the entire row (or even better only the used range to the right of my active cell) in a For/Each loop.
The first part works fine of finding my value, however, the code for targeting the row of the active cell (so the cell found by the find function), does not work yet:
Sub Search()
Dim cell As Range
Dim Count As Long
Set cell = Cells.Find(what:="Planned Supply at BP|SL (EA)", LookIn:=xlValues, lookat:=xlWhole)
For Each cell In ActiveCell.EntireRow
If cell.Value = "0" Then
Count = Count + 1
End If
Next cell
Range("I1").Value = Count
End Sub
The following code will find the range to the right of your found cell and use your loop to do the comparision for each cell in the range. That part could probably be improved by using WorksheetFunction.CountIf.
Option Explicit
Sub Search()
Dim wks As Worksheet
Set wks = ActiveSheet
Dim cell As Range, sngCell As Range
Dim Count As Long
Set cell = wks.Cells.Find(what:="Planned Supply at BP|SL (EA)", LookIn:=xlValues, lookat:=xlWhole)
If cell Is Nothing Then Exit Sub ' just stop in case no hit
Dim rg As Range, lastColumn As Long
With wks
lastColumn = .Cells(cell.Row, .Columns.Count).End(xlToLeft).Column ' last used column in cell.row
Set rg = Range(cell, .Cells(cell.Row, lastColumn)) ' used rg right from found cell inlcuding found cell
End With
' loop from the original post
For Each sngCell In rg
If sngCell.Value = "0" Then
Count = Count + 1
End If
Next
Range("I1").Value = Count
End Sub
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 have a table where sometimes there is data missing in the Column G (7th).
So far I selected a range in this column with my mouse and then ran this macro to fill empty cells with "No Data":
Sub FillEmptyCell()
Dim cell As Range
Dim InputValue As String
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "No Data"
End If
Next
End Sub
However data in that column keeps getting more and I would like to automatically select the entire table range of the 7th column and fill empty cells with "No Data".
How do I implement this?
Try this
Dim lr As Long
lr = Cells(Rows.Count, 7).End(xlUp).Row
Dim Rng As Range
Set Rng = Range("G1:G" & lr)
For Each cell In Rng
If IsEmpty(cell) Then
cell.Value = "No Data"
End If
Next
I just want to know how to loop through the non blank cells on Column A. What I'm trying to do is copy the contents on [A1:B1] to be added on top of each non blank cells on Column A. So far I have counted the non blank cells on column A but I'm stuck. I know that an Offset function should be used for this.
Here's my code so far:
Dim NonBlank as Long
NonBlank = WorksheetFunction.CountA(Worksheet(1).[A:A])
For i = 1 to NonBlank
[A1:B1].Copy Offset(1,0). "I'm stuck here"
Next i
If you are trying to fill the headers for each Product, try this...
Sub FillHeaders()
Dim lr As Long
Dim Rng As Range
lr = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:B1").Copy
For Each Rng In Range("A3:A" & lr).SpecialCells(xlCellTypeConstants, 2).Areas
If Rng.Cells(1).Value <> Range("A1").Value Then
Rng.Cells(1).Offset(-1, 0).PasteSpecial xlPasteAll
End If
Next Rng
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub
As example to simulate the effect of Ctrl-Down from Cell A1 and display the Address, Value in the Immediate Window:
Sub HopToNextNonBlankCellBelow()
Dim oRng As Range
Set oRng = Range("A1")
Debug.Print "Cell Address", "Cell Value"
Do
Set oRng = oRng.End(xlDown)
If Not IsEmpty(oRng) Then Debug.Print oRng.Address(0, 0), oRng.Value
Loop Until oRng.Row = Rows.Count
Set oRng = Nothing
End Sub
Try this... I've (probably) overcounted the rows at 1000, but it likely won't make a difference with your performance. If you wanted to be more precise, there are hundreds of articles on how to find the last row of a range. As for the Offset function, it references a cell in relation to the one we're looping through. In the example below, the code is saying cell.offset(0,1) which means one cell to the right of the cell we are currently looping through. A clearer (less loopy!) example would be if you typed: Range("A10").offset(0,1) it would be the same as typing Range("B10")
Dim Cell As Range
For Each Cell In Range("A2:A1000").Cells
If Not IsEmpty(Cell) Then
Cell.Offset(0, 1).Value = Cell.Value
End If
Next Cell
I have section title cells set at 10 pt font while all other data is set at 9 point font in column A. I am trying to write a vba macro to loop through column A to move each title cell down one row(because the csv leaves a blank cell below them) then move on to the next title cell in the column. Here is my attempt but I'm not sure what I'm doing wrong here.
Sub FontSpacing()
Dim Fnt As Range
For Each Fnt In Range("A8:A5000")
If Fnt.Font.Size = "10" Then
ActiveCell.Cut Destination:=ActiveCell.Offset(",1")
End If
Next
Try this
Sub FontSpacing()
Dim r As Range
For Each r In ThisWorkbook.Worksheets("Sheet1").Range("A8:A5000")
If r.Font.Size = 10 Then
r.Offset(1,0).Value = r.Value
r.Value = vbNullString
End If
Next r
End Sub
The issues:
Offset(",1") shouldn't have the speech marks. I.e. it should be Offset(0,1). In fact, if you want to paste to the row below, then it should be Offset(1,0).
Avoid using ActiveCell. It's not the cell that is looping through your range, it's just the cell that was active on the worksheet when you ran the sub.
Fnt is a bad name for a range, it's probably the reason you got confused. When declaring (dimensioning) a range, try to give it a name that makes it clear you're working with a range.
Extra:
Fully qualify your range reference to avoid an implicit reference to the ActiveSheet e.g. ThisWorkbook.Worksheets("Sheet1").Range("A1").
Avoid cutting an pasting by setting the Value directly
Your indentation is out, which makes it look like a complete Sub, but it's missing the End Sub.
Not sure if you meant 1 Row below or 1 Column right so:
To shift 1 Column:
Sub FontSpacing()
Dim rng As Range, cell As Range
Set rng = Range("A1:A5000")
For Each cell In rng
If cell.Font.Size = "10" Then
cell.Offset(0, 1).Value = cell.Value
cell.Clear
End If
Next
End Sub
To shift 1 Row:
Sub FontSpacing()
Dim rng As Range, cell As Range
Set rng = Range("A1:A5000")
For Each cell In rng
If cell.Font.Size = "10" Then
a = cell.Row + 1
Rows(a & ":" & a).Insert Shift:=xlDown, CopyOrigin:=1
cell.Offset(1, 0).Value = cell.Value
cell.Offset(1, 0).Font.Size = "11"
cell.Clear
End If
Next
End Sub