update row numbers after different active cells in macros followi.

L

LMIV

in macros row numbers remain fixed after a spreadsheet has been added a
series of new rows in specific locations based on the location of the various
active cells following a find command.

can this be improved by automatically opening up correct new rows based on
changing active cell?
 
D

Dave Peterson

you can refer to the row of the cell that contained the value of the Find:

dim FoundCell as range
with activesheet
set foundcell = .cells.find(what:=.....)
end with

if foundcell is nothing then
'not found
else
msgbox foundcell.row
end if

But I bet this isn't quite what you're asking....
 
L

LMIV

Dave Peterson said:
you can refer to the row of the cell that contained the value of the Find:

dim FoundCell as range
with activesheet
set foundcell = .cells.find(what:=.....)
end with

if foundcell is nothing then
'not found
else
msgbox foundcell.row
end if

But I bet this isn't quite what you're asking....
Click to expand...

Here's what I did after that question was posed here:

Since thre are ten rows/lines of information that receive/lose entries due
to the various contents of the "find" command, I decided to do nine different
macros, for each entry inclusion, called hola01-hola09, and then invoke each
particular macro depending on the key value position in the "find" command.

Let me illustrate this with the actual code:

Sub hola01()
'
' hola01 Macro
' Macro recorded 2/8/2005 by Don Davis
'
' Keyboard Shortcut: Ctrl+q
'
Cells.Find(What:="hola01", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K363").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola01", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K377").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola01", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K395").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola01", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K410").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola01", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K429").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola01", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K444").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola01", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K459").Select
Selection.EntireRow.Insert
Range("A459").Select
ActiveWindow.LargeScroll Down:=-1
Range("A414").Select
ActiveWindow.SmallScroll Down:=-40
Range("A362").Select
End Sub

This will add successively a new rowe on the second line of the range where
it needs to go. If I want to open up a different row, based on a different
"find" content, I will use the corresponding macro, such as (3 lines down):

Sub hola04()
'
' hola04 Macro
' Macro recorded 2/8/2005 by Don Davis
'
' Keyboard Shortcut: Ctrl+r
'
Cells.Find(What:="hola04", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K366").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola04", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K380").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola04", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K398").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola04", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K413").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola04", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K432").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola04", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K447").Select
Selection.EntireRow.Insert
Cells.Find(What:="hola04", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("K462").Select
Selection.EntireRow.Insert
Range("A462").Select
ActiveWindow.LargeScroll Down:=-1
Range("A418").Select
ActiveWindow.LargeScroll Down:=-1
Range("A362").Select
End Sub


Now, this is extremely cumbursome, ansd possibly open to inaccuracies as
line numbers change, but it is the best I have got so far.

I will try to implement your method, though.
 
D

Dave Peterson

It's pretty difficult to figure out how many rows down you want to go based on
your code--it just selects a specific range.

But maybe this will give you an idea. (By the way, a lot of this code is stolen
from the example in VBA's help):

Option Explicit
Sub hola01()

Dim FoundCell As Range
Dim FirstAddress As String
Dim wks As Worksheet
Dim HowManyRowsBelow As Long
Dim myStrings As Variant
Dim iCtr As Long

HowManyRowsBelow _
= Application.InputBox("How many Rows Below the foundcell?", _
Type:=1)

If HowManyRowsBelow < 1 Then
Exit Sub
End If

'keep adding as many as you want
myStrings = Array("hola01", "hola02", "hola03", _
"hola04", "hola05", "hola06")

Set wks = ActiveSheet

With wks
For iCtr = LBound(myStrings) To UBound(myStrings)
With .UsedRange
Set FoundCell = .Cells.Find(What:=myStrings(iCtr), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If FoundCell Is Nothing Then
'do nothing
Else
FirstAddress = FoundCell.Address
Do
FoundCell.Offset(HowManyRowsBelow + 1).EntireRow.Insert
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
End With
Next iCtr
End With

End Sub

Test it against a copy of your worksheet--just in case!
 
L

LMIV

Hi Dave Peterson:

From cumbersome,, you have turned things around to brilliant.
The below code was simply altered by removing the "+1" out of the
"FoundCell.Offset(HowManyRowsBelow + 1).EntireRow.Insert" statement.

This caused the sub to insert an empty line right below the search found
line, exactly where it was needed/wanted.


Let me illustrate the achievement:

BEFORE

1998 48142 $393,891 hola01
2001 66841 $546,884 0
2002 11118 $90,966 0
2002 27000 $220,910 0
2003 344 $2,815 0
2003 56853 $465,163 0
1998 165168 $1,351,382 0


1998 48142 $7,600 $15,787 $5,266 $10,521 $7,900 hola01
2001 66841 $6,600 $9,874 $14,522 -$4,648 0
2002 11118 $10,088 $90,736 $43,430 $47,305 $16,900 0
2002 27000 $10,100 $37,407 $43,430 -$6,023 $14,500 0
2003 344 $19,100 $5,552,326 $53,850 $5,498,476 0
2003 56853 $11,100 $19,524 $53,850 -$34,326 0
1998 165168 $2,727 $1,651 $5,266 -$3,615 0






1998 48142 $76,881 $69,281 $5,885 Good hola01
2001 66841 $49,934 $43,334 $9,370 Good 0
2002 11118 $408,290 $398,202 $14,300 Excellent 0
2002 27000 $174,266 $164,166 $13,680 Good 0
2003 344 $24,385,970 $24,366,870 $17,225 Excellent 0
2003 56853 $96,783 $85,683 $12,175 Good 0
1998 165168 $9,973 $7,246 $3,400 Good 0




1998 -1858 912% hola01
2001 16841 657% 0
2002 -38882 3947% 0
2002 -23000 1625% 0
2003 -49656 127575% 0
2003 6853 772% 0
1998 115168 266% 0








1998 30000 $6,200 $3,050 hola01
2001 20000 $9,043 $9,814 30000 0
2002 -40000 $18,550 $11,530
2002 0 $13,299 $15,300
2003 -10000 $16,600 $20,401 0
2003 0 $14,633 $14,600 50000 0
1998 30000 $6,200 $1,513 10/23/04 0



1998 48142 $121,143 2.52 hola01
2001 66841 $153,115 2.29 0
2002 11118 $131,973 11.87 0
2002 27000 $104,644 3.88 0
2003 344 $6,106,121 17750.35 0
2003 56853 $146,920 2.58 0
1998 165168 $342,570 2.07 0




1998:19:59 -1858 $1,400 -$75,481 perfo/vario 0:00:05 10521 1998 48142 5 hola01
2001:17:59 16841 -$2,443 -$52,376 south/vario 2:00:03 -4648 2001 66841 3
2002:08:59 -38882 -$8,462 -$416,752 golde/harri 0:05:06 47305 2002 11118 6
2002:08:59 -23000 -$3,199 -$177,465 wrang/undet 0:00:02 -6023 2002 27000 2
2003:18:59 -49656 $2,500 -$24,383,470 presti/vario 0:00:07
2003 344 7
2003:17:59 6853 -$3,533 -$100,316 river/vario 2:00:01 -34326 2003 56853 1
1998:24:59 115168 -$3,473 -$13,446 pms76/vario 0:00:04 -


AFTER

1998 48142 $393,891 hola01

2001 66841 $546,884 0
2002 11118 $90,966 0
2002 27000 $220,910 0
2003 344 $2,815 0
2003 56853 $465,163 0
1998 165168 $1,351,382 0



1998 48142 $7,600 $15,787 $5,266 $10,521 $7,900 hola01

2001 66841 $6,600 $9,874 $14,522 -$4,648 0
2002 11118 $10,088 $90,736 $43,430 $47,305 $16,900 0
2002 27000 $10,100 $37,407 $43,430 -$6,023 $14,500 0
2003 344 $19,100 $5,552,326 $53,850 $5,498,476 0
2003 56853 $11,100 $19,524 $53,850 -$34,326 0
1998 165168 $2,727 $1,651 $5,266 -$3,615 0






1998 48142 $76,881 $69,281 $5,885 Good hola01

2001 66841 $49,934 $43,334 $9,370 Good 0
2002 11118 $408,290 $398,202 $14,300 Excellent 0
2002 27000 $174,266 $164,166 $13,680 Good 0
2003 344 $24,385,970 $24,366,870 $17,225 Excellent 0
2003 56853 $96,783 $85,683 $12,175 Good 0
1998 165168 $9,973 $7,246 $3,400 Good 0



1998 -1858 912% hola01

2001 16841 657% 0
2002 -38882 3947% 0
2002 -23000 1625% 0
2003 -49656 127575% 0
2003 6853 772% 0
1998 115168 266% 0




1998 30000 $6,200 $3,050 hola01

2001 20000 $9,043 $9,814 30000 0
2002 -40000 $18,550 $11,530 h
2002 0 $13,299 $15,300
2003 -10000 $16,600 $20,401 0
2003 0 $14,633 $14,600 50000 0
1998 30000 $6,200 $1,513 10/23/04 0



1998 48142 $121,143 2.52 hola01

2001 66841 $153,115 2.29 0
2002 11118 $131,973 11.87 0
2002 27000 $104,644 3.88 0
2003 344 $6,106,121 17750.35 0
2003 56853 $146,920 2.58 0
1998 165168 $342,570 2.07 0




1998:19:59 -1858 $1,400 -$75,481 perfo/vario 0:00:05 10521

2001:17:59 16841 -$2,443 -$52,376 south/vario 2:00:03 -4648
2002:08:59 -38882 -$8,462 -$416,752 golde/harri 0:05:06 47305 2002:08:59 -23000 -$3,199 -$177,465 wrang/undet 0:00:02 -6023
2003:18:59 -49656 $2,500 -$24,383,470 presti/vario 0:00:07 7
2003:17:59 6853 -$3,533 -$100,316 river/vario 2:00:01 -34326
1998:24:59 115168 -$3,473 -$13,446 pms76/vario 0:00:04 RGS
I had to trim some of the actual lines information to show you the
appearance in this MS formatted reply box.

This is now independent of any added/deleted lines elsewhere, and works
wonderful for any line added within any year sequence.

This is the opposite direct-record macro for deleted lines, which
works--surprisingly--well after all.

Sub OLDCALC()
'
' OLDCALC Macro
' Macro recorded 2/8/2005 by Don Davis
'
' Keyboard Shortcut: Ctrl+b
'
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Range("A362").Select
End Sub

Thank you, Sir!
 
D

Dave Peterson

Glad you got it working.

Does this mean that you modified the code to look for adios and deleted rows
based on that found cell?

It seems like it should work.
<<snipped>>
 
L

LMIV

Dave Peterson said:
Glad you got it working.

Does this mean that you modified the code to look for adios and deleted rows
based on that found cell?

It seems like it should work.

<<snipped>>
Hi, Dave
Click to expand...
as usual, many activities underway, but clearly your code has made a huge
difference; now, in terms of further automation you can see that what I am
doing is fairly simply: you get to a row with information on a car model
year, open a fresh line for additional information, input it, and so on.

In this next pice of code i have combined parts of your macrodave with
direct recording portions to achieve the placement of the data on the
previous line right onto the newly opened one, such as a duplication would
do; however this is not working due to some compile error in the second
offset code line. If this can be done, with minor updfates/changes one can
follow up on eBay car auction details very quickly. This is the currect
testmacrodave:

Sub TESTNEWCALC()
'
' TESTNEWCALC Macro
' Macro recorded 2/13/2005 by Don Davis
'
' Keyboard Shortcut: Ctrl+m
'

' ADDEDMACRODAVE Macro
' Macro recorded 2/9/2005 by Don Davis

Dim FoundCell As Range
Dim FirstAddress As String
Dim wks As Worksheet
Dim HowManyRowsBelow As Long
Dim myStrings As Variant
Dim iCtr As Long

HowManyRowsBelow _
= Application.InputBox("How many rows below the foundcell?", _
Type:=1)
HowManyRowsAbove _
= Application.InputBox("How many rows above the foundcell?",
Type:=2)


If HowManyRowsBelow < 1 Then


Exit Sub
End If

'(this adds an empty line below found cell line) keep adding as many as
you want
myStrings = Array("hola", "hola01", "hola02", "hola03", _
"hola04", "hola05", "hola06")

Set wks = ActiveSheet

With wks
For iCtr = LBound(myStrings) To UBound(myStrings)
With .UsedRange
Set FoundCell = .Cells.Find(What:=myStrings(iCtr), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If FoundCell Is Nothing Then
'do nothing
Else
FirstAddress = FoundCell.Address
Do
FoundCell.Offset(HowManyRowsBelow).EntireRow.Insert
FoundCell.Ofsset(HowManyRowsAbove).EntireRow.Select
ActiveSheet.Paste
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
End With
Next iCtr
End With
End Sub

Again thank you for your tremendous assistance, which I hope you enjoy
giving...
 
L

LMIV

Dave Peterson said:
Glad you got it working.

Does this mean that you modified the code to look for adios and deleted rows
based on that found cell?

It seems like it should work.

<<snipped>>
Also, Dave, as you saw in previous posting no modification was done, with adios, since the delete line function works rather well with this simple macro:
Click to expand...

ub OLDCALC()
'
' OLDCALC Macro
' Macro recorded 2/8/2005 by Don Davis
'
' Keyboard Shortcut: Ctrl+b
'
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Range("F36").Select
End Sub

see you...
 
L

LMIV

LMIV said:
as usual, many activities underway, but clearly your code has made a huge
difference; now, in terms of further automation you can see that what I am
doing is fairly simply: you get to a row with information on a car model
year, open a fresh line for additional information, input it, and so on.

In this next pice of code i have combined parts of your macrodave with
direct recording portions to achieve the placement of the data on the
previous line right onto the newly opened one, such as a duplication would
do; however this is not working due to some compile error in the second
offset code line. If this can be done, with minor updfates/changes one can
follow up on eBay car auction details very quickly. This is the currect
testmacrodave:

Sub TESTNEWCALC()
'
' TESTNEWCALC Macro
' Macro recorded 2/13/2005 by Don Davis
'
' Keyboard Shortcut: Ctrl+m
'

' ADDEDMACRODAVE Macro
' Macro recorded 2/9/2005 by Don Davis

Dim FoundCell As Range
Dim FirstAddress As String
Dim wks As Worksheet
Dim HowManyRowsBelow As Long
Dim myStrings As Variant
Dim iCtr As Long

HowManyRowsBelow _
= Application.InputBox("How many rows below the foundcell?", _
Type:=1)
HowManyRowsAbove _
= Application.InputBox("How many rows above the foundcell?",
Type:=2)


If HowManyRowsBelow < 1 Then


Exit Sub
End If

'(this adds an empty line below found cell line) keep adding as many as
you want
myStrings = Array("hola", "hola01", "hola02", "hola03", _
"hola04", "hola05", "hola06")

Set wks = ActiveSheet

With wks
For iCtr = LBound(myStrings) To UBound(myStrings)
With .UsedRange
Set FoundCell = .Cells.Find(What:=myStrings(iCtr), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If FoundCell Is Nothing Then
'do nothing
Else
FirstAddress = FoundCell.Address
Do
FoundCell.Offset(HowManyRowsBelow).EntireRow.Insert
FoundCell.Ofsset(HowManyRowsAbove).EntireRow.Select
ActiveSheet.Paste
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
End With
Next iCtr
End With
End Sub

Again thank you for your tremendous assistance, which I hope you enjoy
giving...
Click to expand...

Getting back to the OLDCALC macro, it might have been erroneos, here's an
actual code that works great to delete old lines...

Sub OLDCALC()
'
' OLDCALC Macro
' Macro recorded 2/13/2005 by Don Davis
'
' Keyboard Shortcut: Ctrl+b
'
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Range("F36").Select
End Sub

see you...
 
D

Dave Peterson

Sometimes it's almost too easy to use the copy|paste method of programming.

I think that when you come back to it to make changes, sometimes that simple
loop is easier to understand/modify.
 
L

LMIV

Dave Peterson said:
Sometimes it's almost too easy to use the copy|paste method of programming.

I think that when you come back to it to make changes, sometimes that simple
loop is easier to understand/modify.
Click to expand...

Hi, Dave

Reflecting on past communications I see now that eventually, even though not
very elegant, one finds what the search asks for. In my case, please take a
look at both macros below and see what you think: They simply automate rows
with new information as well as delete unnecesssary lines. This was the
result of several trials until I came up with the tiny button where you can
decide to record a macro using relative row/cell referencesm which was the
crux of the problem, initially.

Here there are:

Sub RELNEWCALC2005()
'
' RELNEWCALC2005 Macro
' Macro recorded 2/15/2005 by Don Davis
'
' Keyboard Shortcut: Ctrl+r
'
Range("A1").Select
Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:X1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Range("A1").Select
Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:Y1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Range("A1").Select
Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:C1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Range("A1").Select
Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:G1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Range("A1").Select
Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:F1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Range("A1").Select
Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:C1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Range("A1").Select
Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:G1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Range("A1").Select
Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:D1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Range("A1").Select
Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:I1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-390, 5).Range("A1").Select
End Sub


Sub RELOLDCALC2005()
'
' RELOLDCALC2005 Macro
' Macro recorded 2/15/2005 by Don Davis
'
' Keyboard Shortcut: Ctrl+t
'
Range("A1").Select
ActiveCell.Offset(50, 0).Range("A1").Select
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
Cells.Find(What:="adios", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.EntireRow.Delete
ActiveCell.Offset(-2, -24).Range("A1").Select
End Sub


Everything is cool, again, for a while anyhow...

LMIV
 
D

Dave Peterson

Your code does a lot of selecting and activating.

Instead of lines like these:

Cells.Find(What:="hola", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, -29).Range("A1").Select
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Range("A1:X1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Range("A1").Select

You could use something like:

dim FoundCell as range
dim destCell as range
with activesheet
set foundcell = .cells.find(what:="hola",after:=.cells(.cells.count), _
lookin:=xlvalues, lookat:=xlpart, _
searchorder:=xlbyrows,searchdirection:=xlnext, _
matchcase:=false, searchformat:=false)
if foundcell is nothing then
'it wasn't found--what should be done?
else
foundcell.offset(1,0).entirerow.insert
set destcell = foundcell.offset(1,0).entirerow.cells(1)
foundcell.entirerow.cells(1).resize(1,24).copy _
destination:=destcell
end if
End with

Be careful. I typed this in the email window, so it may contain lots of typos.

You may want to look at that original reply for other ideas, too.
 
Top