| Home |
| Search |
| Today's Posts |
|
#1
|
|||
|
|||
update row numbers after different active cells in macros followi.
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? |
|
#2
|
|||
|
|||
|
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 |
|
#3
|
|||
|
|||
|
"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. |
|
#4
|
|||
|
|||
|
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 |
|
#5
|
|||
|
|||
|
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 |
|
#6
|
|||
|
|||
|
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. LMIV wrote: <<snipped |
|
#7
|
|||
|
|||
|
"Dave Peterson" wrote: 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. LMIV wrote: <<snipped Hi, Dave 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.Inser t FoundCell.Ofsset(HowManyRowsAbove).EntireRow.Selec t 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... |
|
#8
|
|||
|
|||
|
"Dave Peterson" wrote: 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. LMIV wrote: <<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: 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... |
|
#9
|
|||
|
|||
|
"LMIV" wrote: "Dave Peterson" wrote: 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. LMIV wrote: <<snipped Hi, Dave 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.Inser t FoundCell.Ofsset(HowManyRowsAbove).EntireRow.Selec t 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... 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... |
|
#10
|
|||
|
|||
|
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. LMIV wrote: "Dave Peterson" wrote: 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. LMIV wrote: <<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: 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... -- Dave Peterson |
|
#11
|
|||
|
|||
|
"Dave Peterson" wrote: 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. LMIV wrote: "Dave Peterson" wrote: 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. LMIV wrote: <<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: 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... -- Dave Peterson 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 a 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 |
|
#12
|
|||
|
|||
|
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.coun t), _ 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. LMIV wrote: 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 a 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 -- Dave Peterson |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| autom update cells from Workbook1 to Workbook2 | Excel Discussion (Misc queries) | |||
| Update linked cells within a workbook??? | Links and Linking in Excel | |||
| Converting negative numbers in a range of cells to zero | Excel Discussion (Misc queries) | |||
| Finding Numbers with Cells that also contain letters | Excel Discussion (Misc queries) | |||
| GET.CELL | Excel Worksheet Functions | |||
Linear Mode
