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
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
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
- 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.
Fntis 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.
- Fully qualify your range reference to avoid an implicit reference to the
- Avoid cutting an pasting by setting the
- Your indentation is out, which makes it look like a complete Sub, but it’s missing the
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