+ Reply to Thread
Results 1 to 8 of 8

Copy a formula down in blank cells

Hybrid View

Kevin P Copy a formula down in blank... 06-12-2012, 11:31 AM
arlu1201 Re: Help needed to copy a... 06-13-2012, 03:57 AM
Kevin P Re: Help needed to copy a... 06-13-2012, 04:16 AM
WasWodge Re: Copy a formula down in... 06-13-2012, 06:20 AM
Kevin P Re: Copy a formula down in... 06-13-2012, 06:30 AM
WasWodge Re: Copy a formula down in... 06-13-2012, 06:38 AM
arlu1201 Re: Copy a formula down in... 06-13-2012, 06:43 AM
WasWodge Re: Copy a formula down in... 06-13-2012, 06:47 AM
  1. #1
    Registered User
    Join Date
    06-12-2012
    Location
    London
    MS-Off Ver
    Excel 2007
    Posts
    8

    Copy a formula down in blank cells

    Hi,

    I'm pretty new to VBA and I need to create a macro. I have managed part by using the record macro function (though I'm sure this can be simplified). However, I am coming unstuck as I do not know how to copy the fomulae in column T down to the last cell in column T where the colum one to the left (S) contains data. The current macro just copies down to a pre specied cell. I alos then need to sum the column of data.

    Below is how my macro currently looks. Any help you can give me with the Macro would be very much appreciated.

    Sub DATACASHCHECK2()
    '
    ' DATACASHCHECK2 Macro
    '
    
    '
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
            , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
            Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
            25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), _
            Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array( _
            38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), _
            Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1)), TrailingMinusNumbers:=True
        Cells.Select
        Cells.EntireColumn.AutoFit
        ActiveWindow.ScrollColumn = 2
        ActiveWindow.ScrollColumn = 3
        ActiveWindow.ScrollColumn = 4
        ActiveWindow.ScrollColumn = 5
        ActiveWindow.ScrollColumn = 6
        ActiveWindow.ScrollColumn = 7
        ActiveWindow.ScrollColumn = 8
        ActiveWindow.ScrollColumn = 9
        ActiveWindow.ScrollColumn = 10
        Columns("T:T").Select
        Selection.Insert Shift:=xlToRight
        Range("T2").Select
        ActiveCell.FormulaR1C1 = "=IF(RIGHT(RC[-1],3)=""C"",-RC[1],RC[1])"
        Range("T2").Select
        Selection.Copy
        Range("T3:T228").Select
        ActiveWindow.SmallScroll Down:=-21
        ActiveWindow.ScrollRow = 169
        ActiveWindow.ScrollRow = 163
        ActiveWindow.ScrollRow = 160
        ActiveWindow.ScrollRow = 157
        ActiveWindow.ScrollRow = 154
        ActiveWindow.ScrollRow = 151
        ActiveWindow.ScrollRow = 145
        ActiveWindow.ScrollRow = 139
        ActiveWindow.ScrollRow = 133
        ActiveWindow.ScrollRow = 127
        ActiveWindow.ScrollRow = 119
        ActiveWindow.ScrollRow = 110
        ActiveWindow.ScrollRow = 92
        ActiveWindow.ScrollRow = 74
        ActiveWindow.ScrollRow = 60
        ActiveWindow.ScrollRow = 48
        ActiveWindow.ScrollRow = 39
        ActiveWindow.ScrollRow = 36
        ActiveWindow.ScrollRow = 33
        ActiveWindow.ScrollRow = 30
        ActiveWindow.ScrollRow = 27
        ActiveWindow.ScrollRow = 25
        ActiveWindow.ScrollRow = 19
        ActiveWindow.ScrollRow = 16
        ActiveWindow.ScrollRow = 10
        ActiveWindow.ScrollRow = 4
        ActiveWindow.ScrollRow = 1
        Range("T3:T2210").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveWindow.SmallScroll Down:=75
        ActiveWindow.ScrollRow = 77
        ActiveWindow.ScrollRow = 80
        ActiveWindow.ScrollRow = 83
        ActiveWindow.ScrollRow = 89
        ActiveWindow.ScrollRow = 95
        ActiveWindow.ScrollRow = 119
        ActiveWindow.ScrollRow = 154
        ActiveWindow.ScrollRow = 280
        ActiveWindow.ScrollRow = 430
        ActiveWindow.ScrollRow = 542
        ActiveWindow.ScrollRow = 659
        ActiveWindow.ScrollRow = 803
        ActiveWindow.ScrollRow = 927
        ActiveWindow.ScrollRow = 1024
        ActiveWindow.ScrollRow = 1159
        ActiveWindow.ScrollRow = 1285
        ActiveWindow.ScrollRow = 1368
        ActiveWindow.ScrollRow = 1456
        ActiveWindow.ScrollRow = 1565
        ActiveWindow.ScrollRow = 1615
        ActiveWindow.ScrollRow = 1697
        ActiveWindow.ScrollRow = 1785
        ActiveWindow.ScrollRow = 1870
        ActiveWindow.ScrollRow = 1944
        ActiveWindow.ScrollRow = 2008
        ActiveWindow.ScrollRow = 2035
        ActiveWindow.ScrollRow = 2050
        ActiveWindow.ScrollRow = 2061
        ActiveWindow.ScrollRow = 2073
        ActiveWindow.ScrollRow = 2091
        ActiveWindow.ScrollRow = 2105
        ActiveWindow.ScrollRow = 2117
        ActiveWindow.ScrollRow = 2123
        ActiveWindow.ScrollRow = 2126
        ActiveWindow.ScrollRow = 2129
        ActiveWindow.ScrollRow = 2132
        ActiveWindow.ScrollRow = 2135
        ActiveWindow.ScrollRow = 2138
        ActiveWindow.ScrollRow = 2141
        ActiveWindow.ScrollRow = 2147
        ActiveWindow.ScrollRow = 2149
        ActiveWindow.ScrollRow = 2152
        ActiveWindow.ScrollRow = 2155
        ActiveWindow.ScrollRow = 2161
        ActiveWindow.ScrollRow = 2167
        ActiveWindow.ScrollRow = 2170
        ActiveWindow.ScrollRow = 2173
        ActiveWindow.SmallScroll Down:=18
        Range("T2213").Select
        ActiveCell.FormulaR1C1 = "=SUM(R[-2211]C:R[-1]C)"
        Range("T2214").Select
    End Sub
    Thanks all for your help,

    Kp
    Last edited by Kevin P; 06-13-2012 at 06:43 AM. Reason: Code tags

  2. #2
    Forum Contributor arlu1201's Avatar
    Join Date
    09-09-2011
    Location
    Bangalore, India
    MS-Off Ver
    Excel 2003 & 2007
    Posts
    19,167

    Re: Help needed to copy a furmula down in blank cells.

    One major cleanup you can do is remove all the ActiveWindow.ScrollRow and smallscroll lines.

    Why dont you attach the file that you are using?

    Why are you using text to columns at the beginning of your code?
    If I have helped, Don't forget to add to my reputation (click on the star below the post)
    Don't forget to mark threads as "Solved" (Thread Tools->Mark thread as Solved)
    Use code tags when posting your VBA code: [code] Your code here [/code]

  3. #3
    Registered User
    Join Date
    06-12-2012
    Location
    London
    MS-Off Ver
    Excel 2007
    Posts
    8

    Re: Help needed to copy a furmula down in blank cells.

    Hi Arlette,

    I'm pasting in a file from note pad to excel, I then have to split by pipe delimited. Which is the reason for the text to coloumns at the start. I'm then adding a column after S. The purpose of this column is a to add a new value based on the debit or credit in coloumn S. I then need to copy the formulae down to the last row of data, which will vary each day. Then sum it at the bottom. It's a quick check I need to conduct to make sure the file always come to zero.

    I have attached the file I'm using, having taken out any confidential information.


    Kevin,
    Attached Files Attached Files

  4. #4
    Valued Forum Contributor WasWodge's Avatar
    Join Date
    08-02-2010
    Location
    Hampshire,England
    MS-Off Ver
    Office 365 and Office 2010
    Posts
    883

    Re: Copy a formula down in blank cells

    Kevin, try this.
    BTW, you don't have to copy/paste from notepad, turn on the recorder and click open file (or import) and select the file, it will say its not a recognised filetype and then give you the text to columns dialog, set your arrays and then replace the code in red with the new code. Then you can run the code without opening the text doc.
    Sub DATACASHCHECK2()
    Sub DATACASHCHECK2()
     Dim LastRow As Long
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
            1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
            , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
            Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
            25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), _
            Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array( _
            38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), _
            Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1)), TrailingMinusNumbers:=True
        Cells.Select
        Cells.EntireColumn.AutoFit
        Columns("T:T").Insert Shift:=xlToRight
        LastRow = Cells(Rows.Count, "S").End(xlUp).Row
        Range("S2:S" & LastRow).Offset(0, 1).FormulaR1C1 = "=IF(RIGHT(RC[-1],3)=""C"",-RC[1],RC[1])"
        Range("T2").End(xlDown).Offset(1, 0).FormulaR1C1 = "=sum(r2c:r[-1]c)"
       Range("T2").End(xlDown).NumberFormat = "0.00"
    End Sub
    If my solution worked (or not) please let me know. If your question is answered then please remember to mark it solved

    Computers are like air conditioners. They work fine until you start opening windows. ~Author Unknown

  5. #5
    Registered User
    Join Date
    06-12-2012
    Location
    London
    MS-Off Ver
    Excel 2007
    Posts
    8

    Re: Copy a formula down in blank cells

    WasWodge,

    Thanks you so much. Works perfectly and exactly what I need.

    Great forum, did not expect a resoloution so quickly!!!

    kev,

  6. #6
    Valued Forum Contributor WasWodge's Avatar
    Join Date
    08-02-2010
    Location
    Hampshire,England
    MS-Off Ver
    Office 365 and Office 2010
    Posts
    883

    Re: Copy a formula down in blank cells

    No problem. If you consider the question answered remember to mark the thread as "solved".


    To mark your thread solved do the following:
    - Go to the first post
    - Click edit
    - Click Advance
    - Just below the word "Title:" you will see a dropdown with the word No prefix.
    - Change to Solve
    - Click Save

  7. #7
    Forum Contributor arlu1201's Avatar
    Join Date
    09-09-2011
    Location
    Bangalore, India
    MS-Off Ver
    Excel 2003 & 2007
    Posts
    19,167

    Re: Copy a formula down in blank cells

    Alternatively,

    Marking threads "Solved" just got better. Select Thread Tools (on top of your 1st post) -> Mark this thread as Solved. To undo the action, just go back to Thread Tools -> Mark this thread as Unsolved.

  8. #8
    Valued Forum Contributor WasWodge's Avatar
    Join Date
    08-02-2010
    Location
    Hampshire,England
    MS-Off Ver
    Office 365 and Office 2010
    Posts
    883

    Re: Copy a formula down in blank cells

    Thanks for that Arlu, forgot about the new method of marking posts solved.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1