View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default execution of code takes very long


Dim Suffix_Array as Variant
Dim num as Long
Dim lastow as Long
Dim rng as Range, sVal as String
Dim k as long, j as long, i as long
Suffix_array = Array( "AA$", "AL$", "LA$", "LL$",_
"LU$", "IA$", "IL$", "IVV", " AAS", "ALS", "LAS", _
"LLS", "LUS", "IAS", "ILS")
Application.Calculation = xlManual
num = ubound(Suffix_array) - lbound(suffix_array) + 1
set lastrow = cells(rows.count,1).End(xlup).row
for i = lastrow to 2 step -1
set rng = cells(i,1).offset(1,0).Resize(num-1,1).Entirerow
rng.Insert
cells(i,1).Entirerow.copy destination:=rng
sVal = cells(i,1).value
k = 0
for j = lbound(suffix_array) to ubound(suffix_array)
cells(i,1)(k).Value = sVal & "" & suffix_array(j)
next
Next
Application.Calculation = xlAutomatic

Untested but should be close. Test it on a copy of your data.

--
Regards,
Tom Ogilvy

"Ritesh S." wrote in message
...
This code is suppose to take the value of the row and
insert it above the current row and add the suffix at the
end.
IN THIS CASE... I am starting with list of 30 product and
there are 15 suffix...so it takes each product and insert
15 lines with different suffix from array. (30*15=450rows)

It seems simple to me... Sometimes it takes very long
time for execution...sometimes if i close the file and
open it again...it does it faster...but lately its not
even doing that...

Can you please suggest how i can make this work faster or
if i need clear the clipboard or variables...and how do i
do that...

Please help...

Thank you very much in advance...
-------------------------------------

Suffix_array = Array
("AA$", "AL$", "LA$", "LL$", "LU$", "IA$", "IL$", "IVV", "
AAS", "ALS", "LAS", "LLS", "LUS", "IAS", "ILS")

With Sheets(PROD_Sheet)

Cur_row = 2
Do While .Cells(Cur_row, 1) < ""
Find_row = .Columns(1).Find(.Cells(Cur_row,
1), , xlValues, xlPart).Row
If Find_row = Cur_row Then
For Each suf In Suffix_array
With .Rows(Cur_row)
.Copy
.Insert (xlDown)
End With
.Cells(Cur_row, 1) = .Cells(Cur_row,
1) & "" & suf
Cur_row = Cur_row + 1
Next
End If
.Rows(Cur_row).Delete (xlUp)
Loop

--------------------------------------------