Home » excel » excel – Looping through a column to move cells with font size 10 down one row

excel – Looping through a column to move cells with font size 10 down one row

Posted by: admin April 23, 2020 Leave a comment

Questions:

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
How to&Answers:

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.

Answer:

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