ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Dynamic Selection Find Function (https://www.excelbanter.com/excel-programming/336850-dynamic-selection-find-function.html)

Junior728
Dynamic Selection Find Function
 
Hi Sir,

i am trying to find active cell value(Testing) from a column set of data but
when it comes to line:

Testing = Cells(i, 2).Value

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

it cannot continue to run the rest of the macro? why? Other than selection
find function, is there any other alternate function to obtain the same
results? Thanks.



Example:

Sub Reschedule()

Range("A1").Select
With Application
.Calculation = xlAutomatic
End With
With Application
.ReferenceStyle = xlA1
End With


Range("A1").Select
NumOfRows = Cells(Rows.Count, 1).End(xlUp).Row

Workbooks.Open Filename:="G:\Asia\Product\Operations\Part
Adjustments\VSJ Reschedule\vsj.xls"
Windows("vsj.xls").Activate

Windows("VSJ Reschedule1.xls").Activate
Sheets.Add

Windows("vsj.xls").Activate
Sheets("vsj").Select
Application.CutCopyMode = False
Sheets("vsj").Copy After:=Workbooks("VSJ Reschedule1.xls").Sheets(2)
ActiveWindow.SmallScroll Down:=-15


Windows("VSJ Reschedule1.xls").Activate
Sheets("Sheet1").Select


i = ActiveCell.Row

Testing = Cells(i, 2).Value

Range("B2").Select
For i = 2 To NumOfRows

If Not IsError(Testing) Then

ActiveCell.Select
Selection.Copy

Sheets("vsj").Select
Columns("F:F").Select

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste

End If

Next i

MsgBox ("Please run Macro2 after filling in all info")

End Sub

Jim Thomlinson[_4_]
Dynamic Selection Find Function
 
The attached code copies the all rows where the word Testing appears in
column F of sheet 1 and pastes the result in sheet 2

Sub CopyTestingRows()
Dim wksToSearch As Worksheet
Dim wksToPaste As Worksheet
Dim rngToSearch As Range
Dim rngToPaste As Range
Dim rngCurrent As Range
Dim rngFirst As Range
Dim rngFound As Range

Set wksToSearch = Sheets("sheet1")
Set wksToPaste = Sheets("Sheet2")
Set rngToSearch = wksToSearch.Columns(6)
Set rngToPaste = wksToPaste.Range("A2")

Set rngCurrent = rngToSearch.Find("Testing")
If rngCurrent Is Nothing Then
MsgBox "Testing was not found"
Else
Set rngFirst = rngCurrent
Set rngFound = rngCurrent
Do
Set rngFound = Union(rngCurrent, rngFound)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngFirst.Address = rngCurrent.Address
rngFound.EntireRow.Copy rngToPaste
End If

End Sub

--
HTH...

Jim Thomlinson


"Junior728" wrote:

Hi Sir,

i am trying to find active cell value(Testing) from a column set of data but
when it comes to line:

Testing = Cells(i, 2).Value

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

it cannot continue to run the rest of the macro? why? Other than selection
find function, is there any other alternate function to obtain the same
results? Thanks.



Example:

Sub Reschedule()

Range("A1").Select
With Application
.Calculation = xlAutomatic
End With
With Application
.ReferenceStyle = xlA1
End With


Range("A1").Select
NumOfRows = Cells(Rows.Count, 1).End(xlUp).Row

Workbooks.Open Filename:="G:\Asia\Product\Operations\Part
Adjustments\VSJ Reschedule\vsj.xls"
Windows("vsj.xls").Activate

Windows("VSJ Reschedule1.xls").Activate
Sheets.Add

Windows("vsj.xls").Activate
Sheets("vsj").Select
Application.CutCopyMode = False
Sheets("vsj").Copy After:=Workbooks("VSJ Reschedule1.xls").Sheets(2)
ActiveWindow.SmallScroll Down:=-15


Windows("VSJ Reschedule1.xls").Activate
Sheets("Sheet1").Select


i = ActiveCell.Row

Testing = Cells(i, 2).Value

Range("B2").Select
For i = 2 To NumOfRows

If Not IsError(Testing) Then

ActiveCell.Select
Selection.Copy

Sheets("vsj").Select
Columns("F:F").Select

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste

End If

Next i

MsgBox ("Please run Macro2 after filling in all info")

End Sub

Junior728
Dynamic Selection Find Function
 
Hi Jim,

What if i wish to find specific values entered down the column K of sheet 1
and not a fixed character/value/number("Testing")? Is there anyway of doing
that? And i wish that the the macro will continue to run until it detect the
last row of data.

"Jim Thomlinson" wrote:

The attached code copies the all rows where the word Testing appears in
column F of sheet 1 and pastes the result in sheet 2

Sub CopyTestingRows()
Dim wksToSearch As Worksheet
Dim wksToPaste As Worksheet
Dim rngToSearch As Range
Dim rngToPaste As Range
Dim rngCurrent As Range
Dim rngFirst As Range
Dim rngFound As Range

Set wksToSearch = Sheets("sheet1")
Set wksToPaste = Sheets("Sheet2")
Set rngToSearch = wksToSearch.Columns(6)
Set rngToPaste = wksToPaste.Range("A2")

Set rngCurrent = rngToSearch.Find("Testing")
If rngCurrent Is Nothing Then
MsgBox "Testing was not found"
Else
Set rngFirst = rngCurrent
Set rngFound = rngCurrent
Do
Set rngFound = Union(rngCurrent, rngFound)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngFirst.Address = rngCurrent.Address
rngFound.EntireRow.Copy rngToPaste
End If

End Sub

--
HTH...

Jim Thomlinson


"Junior728" wrote:

Hi Sir,

i am trying to find active cell value(Testing) from a column set of data but
when it comes to line:

Testing = Cells(i, 2).Value

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

it cannot continue to run the rest of the macro? why? Other than selection
find function, is there any other alternate function to obtain the same
results? Thanks.



Example:

Sub Reschedule()

Range("A1").Select
With Application
.Calculation = xlAutomatic
End With
With Application
.ReferenceStyle = xlA1
End With


Range("A1").Select
NumOfRows = Cells(Rows.Count, 1).End(xlUp).Row

Workbooks.Open Filename:="G:\Asia\Product\Operations\Part
Adjustments\VSJ Reschedule\vsj.xls"
Windows("vsj.xls").Activate

Windows("VSJ Reschedule1.xls").Activate
Sheets.Add

Windows("vsj.xls").Activate
Sheets("vsj").Select
Application.CutCopyMode = False
Sheets("vsj").Copy After:=Workbooks("VSJ Reschedule1.xls").Sheets(2)
ActiveWindow.SmallScroll Down:=-15


Windows("VSJ Reschedule1.xls").Activate
Sheets("Sheet1").Select


i = ActiveCell.Row

Testing = Cells(i, 2).Value

Range("B2").Select
For i = 2 To NumOfRows

If Not IsError(Testing) Then

ActiveCell.Select
Selection.Copy

Sheets("vsj").Select
Columns("F:F").Select

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste

End If

Next i

MsgBox ("Please run Macro2 after filling in all info")

End Sub

Junior728
Dynamic Selection Find Function
 
Hi,

Any one can help me with this? no response for a while. =)

"Junior728" wrote:

Hi Sir,

i am trying to find active cell value(Testing) from a column set of data but
when it comes to line:

Testing = Cells(i, 2).Value

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

it cannot continue to run the rest of the macro? why? Other than selection
find function, is there any other alternate function to obtain the same
results? Thanks.



Example:

Sub Reschedule()

Range("A1").Select
With Application
.Calculation = xlAutomatic
End With
With Application
.ReferenceStyle = xlA1
End With


Range("A1").Select
NumOfRows = Cells(Rows.Count, 1).End(xlUp).Row

Workbooks.Open Filename:="G:\Asia\Product\Operations\Part
Adjustments\VSJ Reschedule\vsj.xls"
Windows("vsj.xls").Activate

Windows("VSJ Reschedule1.xls").Activate
Sheets.Add

Windows("vsj.xls").Activate
Sheets("vsj").Select
Application.CutCopyMode = False
Sheets("vsj").Copy After:=Workbooks("VSJ Reschedule1.xls").Sheets(2)
ActiveWindow.SmallScroll Down:=-15


Windows("VSJ Reschedule1.xls").Activate
Sheets("Sheet1").Select


i = ActiveCell.Row

Testing = Cells(i, 2).Value

Range("B2").Select
For i = 2 To NumOfRows

If Not IsError(Testing) Then

ActiveCell.Select
Selection.Copy

Sheets("vsj").Select
Columns("F:F").Select

Selection.Find(What:=Testing, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste

End If

Next i

MsgBox ("Please run Macro2 after filling in all info")

End Sub


All times are GMT +1. The time now is 10:24 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com