Subscript out of range, and more

[John Pierce]

The following procedure works perfectly except that it generates a
"Subscript out of range" error message when it finishes, which doesn't
affect its performance but is annoying. Also, I am pretty sure this
code could be cleaned up and straightened out by someone with more
knowledge than I have. Any help would be appreciated.

Public Sub CopyAccountActivitytoTransactions()
Dim myArray As Variant
Dim numRows As Long
Dim i As Integer
Dim ShX As Worksheet
Dim StartHere As Integer

Set ShX = Worksheets("Transactions")

Worksheets("Account Activity").Activate
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
numRows = Selection.Rows.Count
Range("A1").Select

ReDim myArray(numRows, 7)

myArray = Sheets("Account Activity").Range(Cells(2, 1), Cells
(numRows, 7))

ShX.Activate
ActiveSheet.Range("A65536").Select
Selection.End(xlUp).Select
' ActiveCell.Offset(1, 0).Range("A1").Activate
StartHere = ActiveCell.Offset(1, 0).Row - 1

With ActiveSheet
For i = 1 To numRows
.Cells(i + StartHere, 1) = myArray(i, 4)
.Cells(i + StartHere, 2) = "=IF(AND
(Event=""Transfer"",Amount<0),""Sell Shares"",IF
(Event=""Dividend"",""Reinvest"",""Buy Shares""))"
.Cells(i + StartHere, 3) = myArray(i, 2)
.Cells(i + StartHere, 4) = ""
.Cells(i + StartHere, 5) = myArray(i, 1)
.Cells(i + StartHere, 6) = myArray(i, 5)
.Cells(i + StartHere, 7) = myArray(i, 7)
.Cells(i + StartHere, 8) = myArray(i, 6)
.Cells(i + StartHere, 9) = "=IF(Security=""Some Stock
Fund"",Amount/SharePrice,UnitsShares)"
.Cells(i + StartHere, 10) = "=IF(Security=""Some Stock
Fund"",VLOOKUP(ProcessDate,Prices,5,FALSE),UnitPrice)"
.Cells(i + StartHere, 11) = myArray(i, 3)
Next i
End With
ActiveCell.Select
End Sub

 

[Bernie Deitrick]

John,

your basic mistake is that your array has NumRows - 1 elements, because you
set it equal to a range from row 2 to row NumRows.

So, you could use

For i = 1 To numRows - 1

Or, better I think, would be to use the range object instead of an array:


To do that, instead of

Dim myArray As Variant
and
ReDim myArray(numRows, 7)
myArray = Sheets("Account Activity").Range(Cells(2, 1), Cells(numRows, 7))

Use

Dim myArray As Range
Set myArray = Sheets("Account Activity").Range(Cells(2, 1), Cells(numRows,
7))

then use

For i = 2 To numRows

instead of

For i = 1 To numRows




HTH,
Bernie
MS Excel MVP

 

[John Pierce]

If I "pick up" the data as a range, how then do I "lay it down" on the
other sheet as individual cells?

 

[Bernie Deitrick]

John,

Simply paste values - no need to loop. Below is how I would do it - copy values from Account
Activity to the bottom of Transactions.

HTH,
Bernie
MS Excel MVP


Public Sub CopyAccountActivitytoTransactions2()
Dim numRows As Long
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim StartHere As Long

Set Sht1 = Worksheets("Transactions")
Set Sht2 = Worksheets("Account Activity")

StartHere = Sht1.Cells(Rows.Count, 1).End(xlUp).Row + 1
numRows = Sht2.Cells(Rows.Count, 1).End(xlUp).Row - 1

Sht1.Cells(StartHere, 1).Resize(numRows).Value = _
Sht2.Cells(2, 4).Resize(numRows).Value
Sht1.Cells(StartHere, 2).Resize(numRows).Formula = _
"=IF(AND(Event=""Transfer"",Amount<0),""Sell Shares""," & _
" IF(Event=""Dividend"",""Reinvest"",""Buy Shares""))"
Sht1.Cells(StartHere, 3).Resize(numRows).Value = _
Sht2.Cells(2, 2).Resize(numRows).Value
Sht1.Cells(StartHere, 4).Resize(numRows).Value = ""
Sht1.Cells(StartHere, 5).Resize(numRows).Value = _
Sht2.Cells(2, 1).Resize(numRows).Value
Sht1.Cells(StartHere, 6).Resize(numRows).Value = _
Sht2.Cells(2, 5).Resize(numRows).Value
Sht1.Cells(StartHere, 7).Resize(numRows).Value = _
Sht2.Cells(2, 7).Resize(numRows).Value
Sht1.Cells(StartHere, 8).Resize(numRows).Value = _
Sht2.Cells(2, 6).Resize(numRows).Value
Sht1.Cells(StartHere, 9).Resize(numRows).Formula = _
"=IF(Security=""Some Stock Fund"",Amount/SharePrice,UnitsShares)"
Sht1.Cells(StartHere, 10).Resize(numRows).Formula = _
"'=IF(Security=""Some Stock Fund""," & _
"VLOOKUP(ProcessDate,Prices,5,FALSE),UnitPrice)"
Sht1.Cells(StartHere, 11).Resize(numRows).Value = _
Sht2.Cells(2, 3).Resize(numRows).Value
End Sub

 

[Bernie Deitrick]

Oops, I forgot to take out a single quote from this line:

Sht1.Cells(StartHere, 10).Resize(numRows).Formula = _
"'=IF(Security=""Some Stock Fund""," & _
"VLOOKUP(ProcessDate,Prices,5,FALSE),UnitPrice)"


Should be

Sht1.Cells(StartHere, 10).Resize(numRows).Formula = _
"=IF(Security=""Some Stock Fund""," & _
"VLOOKUP(ProcessDate,Prices,5,FALSE),UnitPrice)"


HTH,
Bernie
MS Excel MVP

 

[John Pierce]

Oops, I forgot to take out a single quote from this line:

Sht1.Cells(StartHere, 10).Resize(numRows).Formula = _
   "'=IF(Security=""Some Stock Fund""," & _
   "VLOOKUP(ProcessDate,Prices,5,FALSE),UnitPrice)"

Should be

Sht1.Cells(StartHere, 10).Resize(numRows).Formula = _
   "=IF(Security=""Some Stock Fund""," & _
   "VLOOKUP(ProcessDate,Prices,5,FALSE),UnitPrice)"

HTH,
Bernie
MS Excel MVP






- Show quoted text -

Bernie
Thanks for the code. It works nicely. I don't understand Resize but I
will use this program to learn how it works. Also, thanks for the clue
to fix my Array program.