Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
slecting data???
if I want to look for only certin data in a column say (Drg) and move the
whole row of data to a new sheet in the workbook an call it " Errors" does anyone know how to approach? Thanks, Lime |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
slecting data???
Give this a try...
Sub MoveErrors() Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues rngAllFound.Delete Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: if I want to look for only certin data in a column say (Drg) and move the whole row of data to a new sheet in the workbook an call it " Errors" does anyone know how to approach? Thanks, Lime |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
slecting data???
Great that brought it over but not the header or the format. What if I want
to pull a string can I pull at once? "Jim Thomlinson" wrote: Give this a try... Sub MoveErrors() Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues rngAllFound.Delete Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: if I want to look for only certin data in a column say (Drg) and move the whole row of data to a new sheet in the workbook an call it " Errors" does anyone know how to approach? Thanks, Lime |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
slecting data???
Sub MoveErrors()
Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues rngAllFound.Delete wksCurrent.Cells.Copy wksNew.Cells.PasteSpecial xlPasteFormats wksCurrent.Rows(1).Copy wksNew.Range("A1") Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: Great that brought it over but not the header or the format. What if I want to pull a string can I pull at once? "Jim Thomlinson" wrote: Give this a try... Sub MoveErrors() Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues rngAllFound.Delete Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: if I want to look for only certin data in a column say (Drg) and move the whole row of data to a new sheet in the workbook an call it " Errors" does anyone know how to approach? Thanks, Lime |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
slecting data???
That last bit of code pasted the formats for the entire sheet. This pastes
the formats for only the effected lines... Sub MoveErrors() Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues wksNew.Range("A2").PasteSpecial xlPasteFormats rngAllFound.Delete wksCurrent.Rows(1).Copy wksNew.Range("A1") Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: Great that brought it over but not the header or the format. What if I want to pull a string can I pull at once? "Jim Thomlinson" wrote: Give this a try... Sub MoveErrors() Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues rngAllFound.Delete Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: if I want to look for only certin data in a column say (Drg) and move the whole row of data to a new sheet in the workbook an call it " Errors" does anyone know how to approach? Thanks, Lime |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
slecting data???
I sorry Jim I ment like if I wanted to pull all the DRG, The kkl, ght, and so
on all at once and move them all at once. Sorry "Jim Thomlinson" wrote: That last bit of code pasted the formats for the entire sheet. This pastes the formats for only the effected lines... Sub MoveErrors() Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues wksNew.Range("A2").PasteSpecial xlPasteFormats rngAllFound.Delete wksCurrent.Rows(1).Copy wksNew.Range("A1") Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: Great that brought it over but not the header or the format. What if I want to pull a string can I pull at once? "Jim Thomlinson" wrote: Give this a try... Sub MoveErrors() Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues rngAllFound.Delete Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: if I want to look for only certin data in a column say (Drg) and move the whole row of data to a new sheet in the workbook an call it " Errors" does anyone know how to approach? Thanks, Lime |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
slecting data???
This code assumes that there is always something in column A of the Rows
being moved. If that is not the case then let me know... Public Sub MoveAllErrors() Call MoveErrors("DRG") Call MoveErrors("ABC") End Sub Private Sub MoveErrors(ByVal strToFind As String) Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim rngToPaste As Range Const SHEETNAME As String = "Errors" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If Not rngFound Is Nothing Then If SheetExists(SHEETNAME, ThisWorkbook) Then Set wksNew = Sheets(SHEETNAME) Else Set wksNew = Worksheets.Add wksNew.Name = SHEETNAME wksCurrent.Rows(1).Copy wksNew.Range("A1") End If Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy Set rngToPaste = wksNew.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) rngToPaste.PasteSpecial xlPasteValues rngToPaste.PasteSpecial xlPasteFormats rngAllFound.Delete wksCurrent.Cells.Copy Application.CutCopyMode = False End If End Sub Public Function SheetExists(SName As String, _ Optional ByVal WB As Workbook) As Boolean 'Chip Pearson On Error Resume Next If WB Is Nothing Then Set WB = ThisWorkbook SheetExists = CBool(Len(WB.Sheets(SName).Name)) End Function -- HTH... Jim Thomlinson "Lime" wrote: I sorry Jim I ment like if I wanted to pull all the DRG, The kkl, ght, and so on all at once and move them all at once. Sorry "Jim Thomlinson" wrote: That last bit of code pasted the formats for the entire sheet. This pastes the formats for only the effected lines... Sub MoveErrors() Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues wksNew.Range("A2").PasteSpecial xlPasteFormats rngAllFound.Delete wksCurrent.Rows(1).Copy wksNew.Range("A1") Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: Great that brought it over but not the header or the format. What if I want to pull a string can I pull at once? "Jim Thomlinson" wrote: Give this a try... Sub MoveErrors() Dim wksCurrent As Worksheet Dim wksNew As Worksheet Dim rngFirst As Range Dim rngFound As Range Dim rngAllFound As Range Dim rngToSearch As Range Dim strToFind As String strToFind = "DRG" Set wksCurrent = Sheets("Sheet1") Set rngToSearch = wksCurrent.Columns("C") Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole) If rngFound Is Nothing Then MsgBox "Sorry. Nothing to Move" Else Set wksNew = Worksheets.Add Set rngFirst = rngFound Set rngAllFound = rngFound.EntireRow Do Set rngAllFound = Union(rngAllFound, rngFound.EntireRow) Set rngFound = rngToSearch.FindNext(rngFound) Loop Until rngFound.Address = rngFirst.Address rngAllFound.Copy wksNew.Range("A2").PasteSpecial xlPasteValues rngAllFound.Delete Application.CutCopyMode = False End If End Sub -- HTH... Jim Thomlinson "Lime" wrote: if I want to look for only certin data in a column say (Drg) and move the whole row of data to a new sheet in the workbook an call it " Errors" does anyone know how to approach? Thanks, Lime |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
slecting all entries to appear once | Excel Worksheet Functions | |||
slecting all entries to appear once | Excel Worksheet Functions | |||
Increase Your Business By Data Conversion, Data Format and Data EntryServices in India | Excel Worksheet Functions | |||
Data Entry Online, Data Format, Data Conversion and Data EntryServices through Data Entry Outsourcing | Excel Discussion (Misc queries) | |||
Slecting worksheets one by one.....possible? | Excel Programming |