Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel Macro for Copy and Paste

Status
Not open for further replies.

mrichey

MIS
Nov 22, 2002
71
US
I need to create a macro that will do the following (using relative referencing)
1) search for specific text string (<<)
2) copy the entire contents of that cell
3) move to the cell below and paste into a comment
4) search for next occurence of the string
5) etc.

When I try it, of course it copies the data the first time and then subsequently copies the same date each time no matter what cell it has moved to. Making sense?

Thanks for any help!
 
Public Sub cmnt()


Dim R As Long
Dim N As Long
Dim Rng As Range
Dim txt As String

txt = InputBox("Type text to search")

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If


For R = Rng.Rows.Count To 1 Step -1
For N = Rng.Columns.Count To 1 Step -1
If Cells(R, N).Value = txt Then
Cells(R, N).Offset(1, 0).AddComment Text:=txt
End If

Next N
Next R


EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub


 
Thank you! But can't get that to work for me. Here's the formula I'm using, for 1 occurence:

Sub test()
'
' test Macro
' Macro recorded 4/21/2005 by Mark Richey
'
' Keyboard Shortcut: Ctrl+t
'
Cells.Find(What:="Monitoring", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = ""
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.Offset(0, -1).Range("A1").AddComment
ActiveCell.Offset(0, -1).Range("A1").comment.Visible = False
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
">> alppdc current dm_ep_engine config at 20Apr2005 14:10" & Chr(10) & "" & Chr(10) & " Collection Monitor Argument Threshold Inter"
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
"val" & Chr(10) & " ---------- ------- -------- --------- --------" & Chr(10) & "e NT_System SysCallsPerSec " _
, Start:=200
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 15m" & Chr(10) & "e NT_NetworkInterface BytesRcvPerSec ""1"" " _
, Start:=400
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 15m" & Chr(10) & "e NT_NetworkInterface BytesSentPerSec ""1"" 15m" & Chr(10) & "e NT_Memory Co" _
, Start:=600
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
"mmittedBytes 15m" & Chr(10) & "d Universal appStatus " _
, Start:=800
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 1h " & Chr(10) & "e NT_System CntxtSwtchPerSec 15" _
, Start:=1000
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
"m" & Chr(10) & "e NT_Processor PrcCpuTime ""0"" > 90 : critical 15m" & Chr(10) & "e NT_Memory PagesPerSec " _
, Start:=1200
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 15m" & Chr(10) & "e NT_Memory PgFltsPerSec " _
, Start:=1400
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 15m" & Chr(10) & "e NT_LogicalDisk FreeMegabytes ""D:"" < 100 : critical 1h " & Chr(10) & "e NT_LogicalDisk FreeMega" _
, Start:=1600
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
"bytes ""C:"" < 100 : critical 1h " & Chr(10) & "e NT_Processor PrcCpuTime ""1"" > 90 : critica" _
, Start:=1800
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
"l 15m" & Chr(10) & "e NT_Processor PrcUsrTime ""1"" 15m" & Chr(10) & "e NT" _
, Start:=2000
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
"_Memory AvailBytes < 4000000 : critical, < 8000000 : severe, < 16000000 : warning 15m" & Chr(10) & "e NT_Processor IntsPerSec ""0"" " _
, Start:=2200
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 15m" & Chr(10) & "e NT_Processor IntsPerSec ""1"" " _
, Start:=2400
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 15m" & Chr(10) & "e Universal ncustom ""c:/tivoli/scripts/cleanperf.pl"" 1h " & Chr(10) & "e NT_PhysicalDisk PrcDskTime " _
, Start:=2600
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" ""0"" 15m" & Chr(10) & "e Universal ncustom ""c:/tivoli/scripts/heartbeat.cmd"" > 0 : warning " _
, Start:=2800
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 15m" & Chr(10) & "e NT_Processor PrcIntTime ""1"" > 70 : critical, > 60 : severe, > 50 : warning 15m" & Chr(10) & "e NT_Syste" _
, Start:=3000
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
"m CpuQueLen 15m" & Chr(10) & "e NT_Processor PrcPrivTime ""0"" " _
, Start:=3200
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 15m" & Chr(10) & "e NT_Processor PrcPrivTime ""1"" " _
, Start:=3400
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" 15m" & Chr(10) & "e NT_Processor PrcUsrTime ""0"" 15m" & Chr(10) & "e NT_Processor PrcIntTime ""0""" _
, Start:=3600
ActiveCell.Offset(0, -1).Range("A1").comment.Text Text:= _
" > 70 : critical, > 60 : severe, > 50 : warning 15m" & Chr(10) & "Done." & Chr(10) & "" _
, Start:=3800
ActiveCell.Offset(1, -1).Range("A1").Select
End Sub

It finds "Monitoring", then moves to the adjoining cell to the right and copies the data out of that cell, then moves back to the cell to the left and pastes that data into the comment. I have to do this for approx 600 occurences.

Thanks!
 


This thread belongs in the VBA Forum Forum707.

Skip,

[glasses] [red]Be advised:[/red]When Viscounts were guillotined just as they were disclosing where their jewels were hidden, it shows to go that you should...
Never hatchet your Counts before they chicken! [tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top