Is there a better way to write this?

[brettvba]

Public sht, k, i, j, numrow
Sub SelectNumRows()
Dim m, n
sht = ActiveSheet.Name
numrow = (CLng(InputBox("Enter Number Of Extra Rows Needed!", "Hello")))
If numrow = Empty Then Exit Sub
Range("A4").Select
Selection.End(xlDown).Select
m = ActiveCell.Offset(0, 2).Address
n = ActiveCell.Offset(0, 3).Address
SelectNumRowCode
Range(m).Select
SelectNumRowCode
Range(n).Select
SelectNumRowCode
End Sub


Sub SelectNumRowCode()
i = ActiveCell.Address
j = ActiveCell.Offset((numrow), 0).Address
k = (i) & ":" & (j)
Worksheets(sht).Range(k).filldown

End Sub

_________________


[ This Message was edited by: brettvba on 2002-05-02 19:44 ]

[ This Message was edited by: brettvba on 2002-05-02 19:45 ]

[Jay Petrulis]

Try,

Sub test()
Dim lastrow As Long, numrow As Long
Dim MyArr, x

On Error Resume Next
numrow = WorksheetFunction.Max(0, (CLng(InputBox("Enter Number Of Extra Rows Needed!", "Hello"))))
If numrow = Empty Then Exit Sub
On Error GoTo 0

MyArr = Array("A", "C", "D")
With ActiveSheet
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        For x = 0 To UBound(MyArr)
            .Range(MyArr(x) & lastrow & ":" & MyArr(x) & lastrow + numrow).FillDown
        Next x
End With

End Sub

In testing the routines, I tried to enter a negative number. It actually works by doing a "FillUp." Try it. I thought that was pretty cool.

Anyway, the MAX() function guards against that possibility. Remove it if desired.

The array MyArr will allow you to change/add/delete the columns you want without much code editing.

OK, I'm outta here! Bye!

[brettvba]

thanks Jay Im not quite up with arrays yet

[Bertie Bagshot]

Here's another way :-

Sub SelectNumRows()
Dim numRow#
On Error Resume Next
numRow = (CLng(InputBox("Enter Number Of Extra Rows Needed!", "Hello")))
On Error GoTo 0
If numRow = Empty Then Exit Sub
With [A4].End(xlDown)
.Resize(numRow + 1, 1).FillDown
.Offset(0, 2).Resize(numRow + 1, 2).FillDown
End With
End Sub



[ This Message was edited by: Bertie Bagshot on 2002-05-02 21:36 ]

[ This Message was edited by: Bertie Bagshot on 2002-05-02 21:38 ]

[Jay Petrulis]

On 2002-05-02 21:15, brettvba wrote:
thanks Jay Im not quite up with arrays yet

Hi,

Nobody is good with arrays, unless your name is Alan Beban (and a few others, of course).

I am trying to learn these myself, so I try to throw things out to the board. I help *AND* I test new ideas, so its a win-win I hope.

Originally, I had this code

With ActiveSheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A" & lastrow & ":A" & lastrow + numrow).FillDown
.Range("C" & lastrow & ":C" & lastrow + numrow).FillDown
.Range("D" & lastrow & ":D" & lastrow + numrow).FillDown
End With

You'll recognize this syntax, but what if you want to add 100 more colums to the fill down? That means 100 more lines of code.

With the array, the first element (starts at 0 unless you explicitly tell it not to) is "A" so my loop places "A" wherever it sees MyArr(0). It then goes to 1 and places the second element "C" wherever it sees MyArr(1) and so on.

The UBound is allows VB to determine how many elements are in the array, rather than me. I initially had it 0 to 2, but if I need to add another column, I would have to change the loop to "0 to 3" and so on. I'm nothing if not lazy, so I want to build the automatic adjustments from the start and then I'm done.

Array formulas are very useful and powerful, but can be overused. Working with arrays in VBA are generally a different story. Most Excellers (definitely including me) would be well advised to learn as much as they can about these.

Bye,
Jay

P.S. Alan Beban, an Excel MVP, has an array function add-in on his website (don't know it off hand) that is way beyond anything I understand. Among other things, it allows you to ReDim any dimension of a multi-dimensional array (VBA only allows the last dimension) and many other things.

[brettvba]

Great thanks Jay

[Jay Petrulis]

Bertie's routine (very nice, btw) also lends itself to being written using a simple array

Sub tester()
Dim MyArr, x As Long

On Error Resume Next
numrow = WorksheetFunction.Max(0, CLng(InputBox("Enter Number Of Extra Rows Needed!", "Hello")))
If numrow = Empty Then Exit Sub
On Error GoTo 0

MyArr = Array(0, 2, 3)

With ActiveSheet.Range("A4").End(xlDown)
    For x = LBound(MyArr) To UBound(MyArr)
        .Offset(0, MyArr(x)).Resize(numrow + 1, 1).FillDown
    Next x
End With

End Sub