View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.misc
Toppers
 
Posts: n/a
Default Macro to find text string in a column and paste data in anothe

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