Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy/Paste rows with specifc text in column d
I posted this to the wrong group yesterday. My apologies, I'm new to this. I'm trying to write a macro that will bring up a text box to ask the user what he/she is looking for (always text). The macro then looks through a monster sheet of 7000 rows and copies every row that contains the text string in column D, then deposits the rows into a new sheet. The text string being searched for is a short piece within a longer string (ie. 'review' within 'project review'). This is what I have so far...I have not been able to copy/paste the row when I get a hit. Private Sub Copy_Paste_Rows_w_Match() Dim ws As Worksheet Dim targetws As Worksheet Dim cl As Range, ctextalues As String, tRow As Long Dim myvalue As String Dim myrow As Range If ActiveWorkbook Is Nothing Then Exit Sub On Error Resume Next If targetws Is Nothing Then Set ws = ActiveSheet Set SourceWB = ActiveWorkbook Set targetws = Worksheets.Add.Worksheets(1) Set targetws = ActiveSheet SourceWB.Activate ws.Activate Set SourceWB = Nothing End If myvalue = InputBox("Find what?") Set ws = ActiveSheet For Each cl In ws.Range("D6:D7000").SpecialCells(xlConstants, xlTextValues).Cells ctextvalues = cl If Len(ctextvalues) 0 Then If InStr(cl, myvalue) 1 Then ctextvalues = myrow.targetws.Activate.Cells.Range("A1") = myrow.ws.Activate ' This is where I am stuck. I have not been able to copy/paste the row when I get a hit. End If Set cl = Nothing End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy/Paste rows with specifc text in column d
Hi Mike
There is code here http://www.rondebruin.nl/copy5.htm Try this example with the data on a sheet named "Sheet1" Sub Copy_With_AutoFilter1() Dim WS As Worksheet Dim WSNew As Worksheet Dim rng As Range Dim Str As String Set WS = Sheets("sheet1") '<<< Change Set rng = WS.Range("D6:D7000") '<<< Change Str = InputBox("Find what?") If Str = "" Then Exit Sub 'Close AutoFilter first WS.AutoFilterMode = False 'This example filter on the first column in the range (change the field if needed) rng.AutoFilter Field:=1, Criteria1:="*" & Str & "*" Set WSNew = Worksheets.Add WS.AutoFilter.Range.Copy With WSNew.Range("A1") ' Paste:=8 will copy the columnwidth in Excel 2000 and higher .PasteSpecial Paste:=8 .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False .Select End With WS.AutoFilterMode = False On Error Resume Next WSNew.Name = Str If Err.Number 0 Then MsgBox "Change the name of : " & WSNew.Name & " manually" Err.Clear End If On Error GoTo 0 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl "Mike Woodard" wrote in message ... I posted this to the wrong group yesterday. My apologies, I'm new to this. I'm trying to write a macro that will bring up a text box to ask the user what he/she is looking for (always text). The macro then looks through a monster sheet of 7000 rows and copies every row that contains the text string in column D, then deposits the rows into a new sheet. The text string being searched for is a short piece within a longer string (ie. 'review' within 'project review'). This is what I have so far...I have not been able to copy/paste the row when I get a hit. Private Sub Copy_Paste_Rows_w_Match() Dim ws As Worksheet Dim targetws As Worksheet Dim cl As Range, ctextalues As String, tRow As Long Dim myvalue As String Dim myrow As Range If ActiveWorkbook Is Nothing Then Exit Sub On Error Resume Next If targetws Is Nothing Then Set ws = ActiveSheet Set SourceWB = ActiveWorkbook Set targetws = Worksheets.Add.Worksheets(1) Set targetws = ActiveSheet SourceWB.Activate ws.Activate Set SourceWB = Nothing End If myvalue = InputBox("Find what?") Set ws = ActiveSheet For Each cl In ws.Range("D6:D7000").SpecialCells(xlConstants, xlTextValues).Cells ctextvalues = cl If Len(ctextvalues) 0 Then If InStr(cl, myvalue) 1 Then ctextvalues = myrow.targetws.Activate.Cells.Range("A1") = myrow.ws.Activate ' This is where I am stuck. I have not been able to copy/paste the row when I get a hit. End If Set cl = Nothing End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy/Paste rows with specifc text in column d
Thanks! I think I can get this to work.
"Ron de Bruin" wrote in message ... Hi Mike There is code here http://www.rondebruin.nl/copy5.htm Try this example with the data on a sheet named "Sheet1" Sub Copy_With_AutoFilter1() Dim WS As Worksheet Dim WSNew As Worksheet Dim rng As Range Dim Str As String Set WS = Sheets("sheet1") '<<< Change Set rng = WS.Range("D6:D7000") '<<< Change Str = InputBox("Find what?") If Str = "" Then Exit Sub 'Close AutoFilter first WS.AutoFilterMode = False 'This example filter on the first column in the range (change the field if needed) rng.AutoFilter Field:=1, Criteria1:="*" & Str & "*" Set WSNew = Worksheets.Add WS.AutoFilter.Range.Copy With WSNew.Range("A1") ' Paste:=8 will copy the columnwidth in Excel 2000 and higher .PasteSpecial Paste:=8 .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False .Select End With WS.AutoFilterMode = False On Error Resume Next WSNew.Name = Str If Err.Number 0 Then MsgBox "Change the name of : " & WSNew.Name & " manually" Err.Clear End If On Error GoTo 0 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl "Mike Woodard" wrote in message ... I posted this to the wrong group yesterday. My apologies, I'm new to this. I'm trying to write a macro that will bring up a text box to ask the user what he/she is looking for (always text). The macro then looks through a monster sheet of 7000 rows and copies every row that contains the text string in column D, then deposits the rows into a new sheet. The text string being searched for is a short piece within a longer string (ie. 'review' within 'project review'). This is what I have so far...I have not been able to copy/paste the row when I get a hit. Private Sub Copy_Paste_Rows_w_Match() Dim ws As Worksheet Dim targetws As Worksheet Dim cl As Range, ctextalues As String, tRow As Long Dim myvalue As String Dim myrow As Range If ActiveWorkbook Is Nothing Then Exit Sub On Error Resume Next If targetws Is Nothing Then Set ws = ActiveSheet Set SourceWB = ActiveWorkbook Set targetws = Worksheets.Add.Worksheets(1) Set targetws = ActiveSheet SourceWB.Activate ws.Activate Set SourceWB = Nothing End If myvalue = InputBox("Find what?") Set ws = ActiveSheet For Each cl In ws.Range("D6:D7000").SpecialCells(xlConstants, xlTextValues).Cells ctextvalues = cl If Len(ctextvalues) 0 Then If InStr(cl, myvalue) 1 Then ctextvalues = myrow.targetws.Activate.Cells.Range("A1") = myrow.ws.Activate ' This is where I am stuck. I have not been able to copy/paste the row when I get a hit. End If Set cl = Nothing End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro to hide rows with zero in specifc column range | Excel Discussion (Misc queries) | |||
summing specifc state abbreviations in a column | New Users to Excel | |||
A macro to copy & paste many rows (a range) to the next column .. | New Users to Excel | |||
Copy/Paste Rows that Contain Specific Text | Excel Worksheet Functions | |||
Hide Rows - copy and paste only rows that show | Excel Worksheet Functions |