VBA AutoFill help needed...

[Lidsavr]

(I am resubmitting a message from yesterday because the previous person helping me is most likely not on the forum today. I have responded, and he or she has not responded back.)

I am running Excel 2007 and writing code that 2003 users will run.

I think this one should be pretty simple, but I keep running into a brick wall . (Ya gotta love the emoticons on this forum; sometimes they get it just right!)

I need help with code that will AutoFill Down a value and add '1' to each cell in the four blank rows below cell E16

(Example: After previous code is run, the value in cell E16 is C2000, I am trying to make the value of E17 value read C2001, E18 = C2002, etc.)

Here is one problem. The next time I run the report, it might have 6 blank cells inserted, so I cannot stipulate a range; that is why I am trying 'selection'. There is data in E21 that I do not want to lose.
I've been trying different code variations for almost 1-1/2 hours and am ready to admit that it could be another 1-1/2 before I figure this out on my own. Can anyone help me with the code?

Here is the code that I have so far. I have highlighted the section I am having problems with in red. (The rest of the code works):

Dim MyRange3 As Range
Sub G_Insert_LocRef_Lines()
[COLOR="Green"]'   Selects Column E to search for cells that have a '-'.[/COLOR]        
        Range("E:E").Select
        Selection.Columns.AutoFit
    Do
        Range("E1").Select
[COLOR="Green"]'       Searchs for hyphens in column E cells ('-').[/COLOR]        
        Cells.Find(What:="-", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
[COLOR="Green"]'       Sets the cell to return to after the text-to-columns transfer is complete.[/COLOR]        
        Set MyRange3 = ActiveCell
[COLOR="green"]'       Performs a text-to-columns command and transfers the data to two cells:
'       Cell I1 and and J1.[/COLOR]
        Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)) _
            , TrailingMinusNumbers:=True
[COLOR="green"]'       Removes leading alpha characters from the cells and transfers the info to
'       Cells I2 and J2.[/COLOR]        
        Range("J2").Select
        ActiveCell.Formula = "=MID(J1,3,6)"
        Range("I2").Select
        ActiveCell.Formula = "=MID(I1,3,6)"
        Range("I2:J2").Select
        Selection.Copy
[COLOR="green"]'       Removes the formula and by copying and performing a 'Paste Special Values
'       command.[/COLOR]        
        Range("I2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
[COLOR="green"]'       Subtracts Cell I2 from J2 to find the number of lines to insert.[/COLOR]        
        Range("L1").Select
        ActiveCell.Formula = "=(J2-I2)"
[COLOR="Green"]'       Returns to the original cell and moves down one row to start inserting lines[/COLOR]        
        MyRange3.Select
        ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Activate
[COLOR="green"]'       Counter to insert the number of lines found in cell L1[/COLOR]        
        For i = 1 To Range("L1").Value
            ActiveCell.EntireRow.Select
            Selection.End(xlToLeft).Select
            Set BeginCell = ActiveCell
            Set EndCell = ActiveCell.Offset(0, 4)
            Range(BeginCell, EndCell).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Next i
[COLOR="green"]'       Copies the first reference designator and pastes it to MyRange3[/COLOR]        
        Range("I1").Select
        Selection.Copy
        MyRange3.Select
        ActiveSheet.Paste
[COLOR="Green"]'       ------------------------------------------------------------------------------
'       This is the area I am getting stuck (performing an autofill that will make the
'       cell I just pasted fill down and increment by one. NOTE this portion of code
'       may not work because I have modified it so much. It is this area that I need help.[/COLOR][COLOR="Red"]        
        Set SourceRange = ActiveCell
        Set fillRange = ActiveCell.Offset(RowOffset:=-1, ColumnOffset:=0)
        SourceRange.AutoFill Destination:=fillRange [COLOR="Green"]' Receives error AutoFill range of
                                                    ' class failed[/COLOR]
        Selection.AutoFill Destination:=ActiveCell.Offset _
            (RowOffset:=1, ColumnOffset:=0).Activate, Type:=xlFillDefault
        ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select
'       ------------------------------------------------------------------------------[/COLOR]
[COLOR="Green"]'      Code picks up again here. What is below works![/COLOR]        
        MyRange3.Select
        For i = 1 To Range("L1").Value
            If MyRange3 > 0 Then
                ActiveCell.EntireRow.Select
                Selection.End(xlToLeft).Select
                Set BeginCell = ActiveCell
                Set EndCell = ActiveCell.Offset(0, 3)
                Range(BeginCell, EndCell).Select
                Selection.Copy
                ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select
                ActiveSheet.Paste
            End If
        Next i
        Range("I1:L3").Select
        Selection.ClearContents
        ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select
    Loop Until ActiveCell = ""
End Sub

In addition, here are the first 25 lines of data stored in a .xls file on my Google Docs page:
https://spreadsheets.google.com/spreadsheet/ccc?key=0AsZFmctoHTEBdDJub2lBRERfcHp2SGtTVUFjU3lscnc&hl=en_US

Thanks again for yours or anyone else's help!

Charles

 

[Joe4]

Duplicate: http://www.mrexcel.com/forum/showthread.php?t=560324

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread. Per forum rules, posts of a duplicate nature will be locked or deleted (rule #9 here: http://www.mrexcel.com/forum/showthread.php?t=99490).