Fill down VBA Code

**joannakf** · 05-14-2012, 07:31 PM

I am trying to fill down a formula in a spreadsheet until the last row, the numbers of records returned will change with every download. I used control shift down on a column next to it and then tabbed over and filled up. It does not work correctly when the number of records change. An ideas?

Windows("movereport_download.xls").Activate
    Columns("H:H").Select
    Selection.NumberFormat = "General"
    Range("H4").Select
    ActiveCell.FormulaR1C1 = "=RC[1]&CHAR(10)&R[1]C[2]&CHAR(10)&RC[3]"
    Range("H4").Select
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveCell.FormulaR1C1 = "=RC[1]&CHAR(10)&RC[2]&CHAR(10)&RC[3]"
    Range("C4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.End(xlDown).Select
    Range("H6").Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Columns("H:H").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=2
    Columns("I:K").Select
    Range("K1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("I5").Select
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1

Range("H6").Select
Is where it tabs over on row 6 instead of where ever the control shift down would end

Thanks in advance!

**WasWodge** · 05-14-2012, 07:48 PM

For the fill part you can try something like

Sub TEST3()
    Dim LastRow As Long
    With ActiveSheet
        LastRow = .UsedRange.Rows.Count
        Range(.Cells(4, 8), .Cells(LastRow, 8)).FormulaR1C1 = "=RC[1]&CHAR(10)&R[1]C[2]&CHAR(10)&RC[3]"
    End With
End Sub

Afraid I don't have time to look at the rest as it is getting on for 1am here

**WasWodge** · 05-15-2012, 01:24 PM

Hopefully this will cover your needs.Try it on a copy of your sheet. Let me know of any issues

Sub TEST3()
    Dim LastRow As Long
    Windows("movereport_download.xls").Activate
Application.ScreenUpdating = True
    With ActiveSheet
        LastRow = .UsedRange.Rows.Count
        Columns("H:H").NumberFormat = "General"
        Range(.Cells(4, 8), .Cells(LastRow, 8)).FormulaR1C1 = "=RC[1]&CHAR(10)&R[1]C[2]&CHAR(10)&RC[3]"
        Columns("H:H").Value = Columns("H:H").Value
        Columns("I:K").Delete Shift:=xlToLeft
        Range("I5").Select
    End With
    Application.ScreenUpdating = False
End Sub

**WasWodge** · 05-15-2012, 08:08 PM

Sorry correction of stupid error

Sub TEST3()
    Dim LastRow As Long
    Windows("movereport_download.xls").Activate
Application.ScreenUpdating = False
    With ActiveSheet
        LastRow = .UsedRange.Rows.Count
        Columns("H:H").NumberFormat = "General"
        Range(.Cells(4, 8), .Cells(LastRow, 8)).FormulaR1C1 = "=RC[1]&CHAR(10)&R[1]C[2]&CHAR(10)&RC[3]"
        Columns("H:H").Value = Columns("H:H").Value
        Columns("I:K").Delete Shift:=xlToLeft
        Range("I5").Select
    End With
    Application.ScreenUpdating = True
End Sub