Need VBA Help with AutoFill (Simple??)...

[Lidsavr]

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: The value in cell E16 is C2000, I am trying to make the value of E17 value read C2001, E18 = C2002, etc.)

Here is the 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. The following code selects E21 and I do not want that to happen:

    Range(Selection, Selection.End(xlDown)).Select

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 what I have so far (although I have modified it so much, it may not make sense:

    Selection.End(xlDown).Select
    ActiveCell.Offset(RowOffset:=-1, ColumnOffset:=0).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.AutoFill Destination:=(Selection)

Thank you,

Charles

 

[ChrisM]

Not understanding, if the range always starts at E17 how does E21 come into play? Where would new cells be inserted - above the working range, within it, or below it?

 

[Lidsavr]

Chris,
Here is the answer to the question. It is kind of long....

My code looks at any cell value in column E that has a hyphen in it. Example cell E16 has a value of C2000-C2004 (this is drawn from another database). I need separate line entries for C2000, C2001, C2002, etc.)

I have created code that does a Text-to-Columns on the cell using the hypen as the value. My code then removes the C from the two value and subtracts the lower value from the higher one. (C2004 becomes 2004 and C000 becomes 2000. The code then subtracts 2000 from 2004 and gets a value of 4. My code then inserts 4 blank lines below E16 (C2000). My next step will add the values I need to E17-E20.

Once I am done with this step I will select and copy A16:D16 and copy it down four times (I already have that code written.

Finally, I will create a Do Loop command and have it repeat as many times as needed until all the values in column E have been looked at for values with hypens.

I hope that makes sense. My only problem is getting the C2000 to fill down. Everything else works!

Thanks for you help,

Charles

 

[ChrisM]

The answer depends then on how you are looping and selecting the current row. Can you post the code?

 

[Lidsavr]

Chris,
I hope you are on the board. I am not authorized overtime, so I needed to leave work yesterday.

Here is the code that I have so far. I have highlighted the section I am trying to code 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 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

 

[ChrisM]

Try this:

ActiveCell.AutoFill Destination:=ActiveCell.Resize(2, 1), Type:=xlFillSeries

 

[Lidsavr]

Chris,
That works great. I had written a work around, but it included a ton of code. Yours is much more compact. I will use it!

Thank you.

Charles