Clever Geek Handbook

Quoting across a column to move cells with font size 10 by one line

I have section header cells set to 10 pt font and all other data is set to 9 point font in column A. I am trying to write a vba macro to loop through column A to move each header cell by one line (because csv leaves a blank cell below them), then move on to the next header cell in the column. Here is my attempt, but I'm not sure what I am 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
+3


source to share


2 answers


try it

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

Problems:



  • Offset(",1")

    should not have speech marks. That is, it should be Offset(0,1)

    . In fact, if you want to insert into the line below, then it should be Offset(1,0)

    .
  • Avoid using ActiveCell

    . This is not the cell that iterates over your range, it is only the cell that was active in the sheet when you ran sub.
  • Fnt

    - bad range name is probably the reason you are confused. When declaring (sizing) a range, try giving it a name that will let you know that you are working with a range.

Additionally:

  • Fully qualify the range reference to avoid implicit reference to ActiveSheet

    eg. ThisWorkbook.Worksheets("Sheet1").Range("A1")

    ...
  • Avoid cutting the insert by directly installing Value

  • Your indent is missing, making it look like a full Sub, but missing End Sub

    .
+2


source


Not sure if you meant 1 row below or 1 column to the right like 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 line:

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
0


source






More articles:


All Articles