Macro to find text string in a column and paste data in another

For various reasons, including the possibility of macro virii, I won't
open your file, but you can do this without a macro...




C2: =IF(A2="To",B2,"")
D2: =IF(A2="Cc",B2,"")

Copy C2:D2 down as far as required.


In article <[email protected]>,
nicolascap <[email protected]>
wrote:

> I have an excel table with 4 columns:
> - Column 1 contains either nothing, "To", or "Cc" as email destination
> fields
> - Column 2 contains different email adresses
> - Column 3 is empty and is named "To"
> - Column 4 is empty and is named "Cc".
>
> Under the first column "email destination field " (containing To, Cc or
> no value), I want to add a button that will read through its totality
> and then , for a given row, add the corresponding email adress to the
> "To" Column if a "To" is read in Column 1 or to the "Cc" Column if a
> "Cc" is read in Column 1, and of course do nothing if nothing is
> mentionned.
>
> I will then use the following macro to go through the "To" and "Cc"
> Columns and create a blank email with the correct email adresses in the
> "To" or "Cc"fields:
>
>
> Attached hereafter the Excel example of my problem

This macro will search column C in sheet1 and once found will copy the row to sheet2, you will have to adjust the sheet names to your specs.
once the search is completed you will have sheet3 referencing sheet2 with the data you want,
You can Add extra code at the begining of the macro incase you want to clear Sheet2 before the search, or else it will just keep adding to it



Sub SearchAndDeliver()

Dim what As String
Dim lastcol As Long
Dim searchRng As Range
Dim FirstFound As Range
Dim NextFound As Range
Dim dest As Range

'Input data to search
what = InputBox("Enter Name", "Search & Deliver")
If what = "" Then Exit Sub


'Initialize src data
With Worksheets("sheet1")
'Set search range
Set searchRng = .Range( _
.Range("C1"), _
.Cells(Rows.Count, "C").End(xlUp) _
)
'calculate last col to move
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

'Initialize dest data
With Worksheets("Sheet2")
Set dest = .Cells(Rows.Count, "A").End(xlUp)
If dest.Value <> "" Then Set dest = dest.Offset(1, 0)
End With

'Start searching
Set FirstFound = searchRng.Find( _
what:=what, _
searchorder:=xlByRows _
)
'Alert and exit if name not found
If FirstFound Is Nothing Then
MsgBox "Name not found", vbExclamation, "Search & Deliver"
Exit Sub
End If
' Move First item
Set NextFound = FirstFound
Do
' Move current item
NextFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=NextFound)
Loop Until NextFound.Address = FirstFound.Address
End Sub

Private Sub CommandButton1_Click()
Dim lastrow As Long, Torow As Long, CcRow As Long
Torow = 3
CcRow = 3
With Worksheets("Tabell1")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
For r = 3 To lastrow
If Cells(r, "C") = "To" Then
Cells(Torow, "J") = Cells(r, "I")
Torow = Torow + 1
Else
If Cells(r, "C") = "Cc" Then
Cells(CcRow, "K") = Cells(r, "I")
CcRow = CcRow + 1
End If
End If
Next
End With

End Sub

"davesexcel" wrote:

>
> This macro will search column C in sheet1 and once found will copy the
> row to sheet2, you will have to adjust the sheet names to your specs.
> once the search is completed you will have sheet3 referencing sheet2
> with the data you want,
> You can Add extra code at the begining of the macro incase you want to
> clear Sheet2 before the search, or else it will just keep adding to it
>
>
>
> Sub SearchAndDeliver()
>
> Dim what As String
> Dim lastcol As Long
> Dim searchRng As Range
> Dim FirstFound As Range
> Dim NextFound As Range
> Dim dest As Range
>
> 'Input data to search
> what = InputBox("Enter Name", "Search & Deliver")
> If what = "" Then Exit Sub
>
>
> 'Initialize src data
> With Worksheets("sheet1")
> 'Set search range
> Set searchRng = .Range( _
> .Range("C1"), _
> .Cells(Rows.Count, "C").End(xlUp) _
> )
> 'calculate last col to move
> lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
> End With
>
> 'Initialize dest data
> With Worksheets("Sheet2")
> Set dest = .Cells(Rows.Count, "A").End(xlUp)
> If dest.Value <> "" Then Set dest = dest.Offset(1, 0)
> End With
>
> 'Start searching
> Set FirstFound = searchRng.Find( _
> what:=what, _
> searchorder:=xlByRows _
> )
> 'Alert and exit if name not found
> If FirstFound Is Nothing Then
> MsgBox "Name not found", vbExclamation, "Search & Deliver"
> Exit Sub
> End If
> ' Move First item
> Set NextFound = FirstFound
> Do
> ' Move current item
> NextFound.Resize(1, lastcol).Copy dest
> Set dest = dest.Offset(1, 0)
> ' Search next item
> Set NextFound = searchRng.FindNext(after:=NextFound)
> Loop Until NextFound.Address = FirstFound.Address
> End Sub
>
>
> --
> davesexcel
> ------------------------------------------------------------------------
> davesexcel's Profile: http://www.excelforum.com/member.php...o&userid=31708
> View this thread: http://www.excelforum.com/showthread...hreadid=522138
>
>

See my reply.

"nicolascap" wrote:

>
> Okay I understand your concern but there is not virus in the file.
>
> Thanks for your answer, it works fine!
>
> Assuming that I would get some code as a response, I may have
> simplified my problem too much though.
>
> There is actually more than one "Column 1 containing either nothing,
> "To", or "Cc" as email destination fields". This is because my final
> goal is to create email distribution lists selectively. Lets say that
> each of these columns containing target email destination fields("To" ,
> "Cc" or nothing) represent a group of people to be emailed as main
> recipient or Cc. Therefore a single person can be "To" and in the next
> Column can be "Cc".
>
> That's why I want to have a button under each of these columns so I'll
> only need to change the range in which the macro is looking for "To" or
> "Cc", and make as much adapted macros as there are columns. The second
> step for this macro being to feed the "to" and "Cc" columns
> appropriately.
>
> This is with the goal of using a second macro behind this to take the
> email adresses in the "to" columns and put them in the "to" field of an
> email.
>
> Hope I am clear enough.
>
> So can this be done in a macro like:
>
> For i=1 to n
> Search for "To" in column 1
>
> If "to" is found then paste corresponding email adress to Column 3
> "To"
> If "Cc" is found then paste corresponding email adress to Column 4
> "Cc"
>
> thanks for your time
>
> nicolas
>
>
> --
> nicolascap
> ------------------------------------------------------------------------
> nicolascap's Profile: http://www.excelforum.com/member.php...o&userid=32044
> View this thread: http://www.excelforum.com/showthread...hreadid=522138
>
>

I did that's why I edited my post.

Can someone tell me how to run two consecutive macros with a single click on a button?

Thanks to this threads' participants.

Nicolas

Sub Commandbutton_Click
Macro1 '<=== first macro
macro2 '<=== second macro
End

"nicolascap" wrote:

>
> I did that's why I edited my post.
>
> Can someone tell me how to run two consecutive macros with a single
> click on a button?
>
> Thanks to this threads' participants.
>
> Nicolas
>
>
> --
> nicolascap
> ------------------------------------------------------------------------
> nicolascap's Profile: http://www.excelforum.com/member.php...o&userid=32044
> View this thread: http://www.excelforum.com/showthread...hreadid=522138
>
>

OK

Thank you very much