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!
"Dave Peterson" wrote:
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!
LMIV wrote:
"Dave Peterson" wrote:
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....
LMIV wrote:
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?
--
Dave Peterson
Hi Dave Petersion and thank you.
Here's what I did after that question was posed he
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.
--
Dave Peterson
|