VBA将公式添加到特定列并向下填充到最后一行

Question

I'm in the process of trying to automate my monthly reporting and I'm finally dipping my toe into VBA (by copying a bunch of stuff I see online and trying to make it work with my project).

I currently have a macro that inserts colums in Column A,H,O etc. and now I want another macro to insert a =CONCATENATE formula into each of them and fill down to last row with data (I'll then string these two macros together).

I currently have the following

Sub FillDown()
Dim strFormulas(1 To 5) As Variant
With ThisWorkbook.Worksheets("CommentsData")
    strFormulas(1) = "=CONCATENATE(B1,C1)"
    strFormulas(2) = "=CONCATENATE(I1,J1)"
    strFormulas(3) = "=CONCATENATE(P1,Q1)"
    strFormulas(4) = "=CONCATENATE(W1,X1)"
    strFormulas(5) = "=CONCATENATE(AD1,AE1)"
    .Range("A1,H1,O1,V1,AC1").Formula = strFormulas
    .Range("A1,H1,O1,V1,AC1").FillDown

    .Range("A:AG").NumberFormat = "General"
End With
End Sub

I'm getting a Runtime 1004 "Filldown method of Range class failed error with the Range Line being highlighted. I assume there is an issue with the way I'm trying to refer to multiple columns that aren't side by side (haven't been able to find examples of this online).

Any help is appreciated.

Follow up question; Once I have this working, I'll want to do it with other worksheets within the workbook as well, but it will be different columns. Do I need to create a new module or can I just paste the code again in the same module and alter the ranges/cell references? If so, which part do I copy/paste

Answer 1

In this specific example you could simplify to:

Option Explicit

Public Sub FillDown1()
    Dim myColumns(), lastRow As Long, i As Long
    myColumns = Array("A", "H", "O", "V", "AC")

    With ThisWorkbook.Worksheets("CommentsData")
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).row 'Change this to a column which you can use to determine how far to add formulas to

        For i = LBound(myColumns) To UBound(myColumns)
            .Range(.Cells(1, myColumns(i)), .Cells(lastRow, myColumns(i))).FormulaR1C1 = "=CONCATENATE(RC[1],RC[2])"
        Next i
        .Range("A:AG").NumberFormat = "General"
    End With
End Sub

Something closer to yours, but boy is it ugly looking:

Public Sub FillDown2()
    Dim myColumns(), lastRow As Long, i As Long, myFormulas(1 To 5) As Variant
    myColumns = Array("A", "H", "O", "V", "AC")
    myFormulas(1) = ("B,C")
    myFormulas(2) = ("I,J")
    myFormulas(3) = ("P,Q")
    myFormulas(4) = ("W,X")
    myFormulas(5) = ("AD,AE")

    If UBound(myColumns) + 1 <> UBound(myFormulas) Then MsgBox "Array length for myColumns doesn't match myFormulas": Exit Sub

    With ThisWorkbook.Worksheets("CommentsData")
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).row 'Change this to a column which you can use to determine how far to add formulas to
        For i = LBound(myColumns) To UBound(myColumns)
            .Cells(1, myColumns(i)).Formula = "=CONCATENATE(" & Split(myFormulas(i + 1), ",")(0) & 1 & "," & Split(myFormulas(i + 1), ",")(1) & 1 & ")"
            .Range(.Cells(1, myColumns(i)), .Cells(lastRow, myColumns(i))).FillDown
        Next i
        .Range("A:AG").NumberFormat = "General"
    End With
End Sub

You could even shift the row (1) back up into the myFormulas array

Public Sub FillDown2()
    Dim myColumns(), lastRow As Long, i As Long, myFormulas(1 To 5) As Variant
    myColumns = Array("A", "H", "O", "V", "AC")
    myFormulas(1) = ("B1,C1")   '<==========================shifted row back up into array
    myFormulas(2) = ("I1,J1")
    myFormulas(3) = ("P1,Q1")
    myFormulas(4) = ("W1,X1")
    myFormulas(5) = ("AD1,AE1")

    If UBound(myColumns) + 1 <> UBound(myFormulas) Then MsgBox "Array length for myColumns doesn't match myFormulas": Exit Sub

    With ThisWorkbook.Worksheets("CommentsData")
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).row 'Change this to a column which you can use to determine how far to add formulas to
        For i = LBound(myColumns) To UBound(myColumns)
            .Cells(1, myColumns(i)).Formula = "=CONCATENATE(" & Split(myFormulas(i + 1), ",")(0) & "," & Split(myFormulas(i + 1), ",")(1) & ")"
            .Range(.Cells(1, myColumns(i)), .Cells(lastRow, myColumns(i))).FillDown
        Next i
        .Range("A:AG").NumberFormat = "General"
    End With
End Sub

Answer 2

you could try this:

Sub FillDown()
    With ThisWorkbook.Worksheets("CommentsData")
        .Range("A:A,H:H,O:O,V:V,AC:AC").Offset(, 1).SpecialCells(xlCellTypeConstants).Offset(, -1).FormulaR1C1 = "=CONCATENATE(RC[1],RC[2])"
        .Range("A:AG").NumberFormat = "General"
    End With
End Sub

to extend it to more worksheets:

Sub FillDownMoreSheets()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets(Array("CommentsData", "CommentsData2", "CommentsData3"))
        With ws
            .Range("A:A,H:H,O:O,V:V,AC:AC").Offset(, 1).SpecialCells(xlCellTypeConstants).Offset(, -1).FormulaR1C1 = "=CONCATENATE(RC[1],RC[2])"
            .Range("A:AG").NumberFormat = "General"
        End With
    Next
End Sub

Answer 3

You should avoid naming your Subs, Functions and variables with reserved words

FillDown will hide the built-in Range.FillDown Method

---

This will work on all sheets defined in the constant at the top

The list in WS_RANGES is separated by a space and contains a sub list of

• SheetName-Range-ColumnOffset ( CommentsData-A1:AG-7 )
• ColumnOffset must be 3 or greater (for the formulas)

---

Option Explicit

Public Sub JoinColumns()

 Const WS_RANGES = "CommentsData-A1:AG-7 CommentsData2-C2:AX-3"  'WSNames-Range-Offset

 Dim wsSet As Variant, ws As Worksheet, ur As Range, cls As Range, i As Variant, c As Long

 wsSet = Split(WS_RANGES)

 For Each ws In ThisWorkbook.Worksheets
   For Each i In wsSet
    i = Split(i, "-")

    If ws.Name = i(0) Then
     Set ur = ws.Range(i(1) & ws.Cells(ws.Rows.Count, Split(i(1),":")(1)).End(xlUp).Row)

     Set cls = ur.Columns(1)
     For c = i(2) + 1 To ur.Columns.Count Step i(2)
      Set cls = Union(cls, ur.Columns(c))
     Next
     cls.Formula = "=RC[1] & RC[2]"

     ur.NumberFormat = "General"
     Exit For
   End If
  Next
 Next
End Sub