Solved: find string in column A and past used range of row to sheet 2

[farrukh]

Hi All,

I need a code that find string name suppose test and then copy the used range of row and paste to specified sheet4. i have to do for this multiple searches suppose test (string) test2 (string) find and paste to sheet4 specific range?

Thanks
hammeed

[mancubus]

this is one way with "FIND Method"...


Sub FindCopy()

Dim ws1 As Worksheet, ws4 As Worksheet
Dim cll As Range, rng As Range
Dim LastRow As Long, LastCol As Long, i As Long, ndx As Long
Dim strLookup As String, FirstAddress As String
Dim strFind

Set ws2 = Worksheets("Sheet2") 'change Sheet2 to actual worksheet name - find and copy
Set ws4 = Worksheets("Sheet4") 'change Sheet4 to actual worksheet name - paste

strLookup = "test1, test2, test3, test4"
strFind = Split(strLookup, ", ")

With ws2
LastRow = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LastCol = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Set rng = .Range("A1:A" & LastRow)
With rng
For ndx = LBound(strFind) To UBound(strFind)
Set cll = .Find(strFind(ndx), LookIn:=xlValues)
If Not cll Is Nothing Then
FirstAddress = cll.Address
Do
i = i + 1
Range(.Cells(cll.Row, 1), .Cells(cll.Row, LastCol)).Copy ws4.Cells(i, 1)
Set cll = .FindNext(cll)
Loop While Not cll Is Nothing And cll.Address <> FirstAddress
End If
Next
End With
End With

End Sub

[farrukh]

Hi mancubus (http://www.vbaexpress.com/forum/member.php?u=37987)

Thanks for reply ... when i just strLookup = "test1" it reterive the data of test1, test10,test11 and so on if i define in hte above string test2 it get all the rows of test 21, test22 and so on.. and i need off set as well when data is present in the used range not whole row then paste the data to next line

Thanks
hameed

[mancubus]

for the first part,

replace
Set cll = .Find(strFind(ndx), LookIn:=xlValues)


with
Set cll = .Find(strFind(ndx), LookIn:=xlValues, lookat:=xlWhole)


i do not understand the second requirement.
i assumed by saying copy the used range of row, you meant whole cells in the row at which lookup string is found.

if you want to copy only found cell then change

Range(.Cells(cll.Row, 1), .Cells(cll.Row, LastCol)).Copy ws4.Cells(i, 1)


to
cll.Copy ws4.Cells(i, 1)

if you want to copy all cells but found cell then change

Range(.Cells(cll.Row, 1), .Cells(cll.Row, LastCol)).Copy ws4.Cells(i, 1)


to

Range(.Cells(cll.Row, 2), .Cells(cll.Row, LastCol)).Copy ws4.Cells(i, 1)

[farrukh]

Hi mancubus (http://www.vbaexpress.com/forum/member.php?u=37987),

The workbook is attached with, in which you find two tabs one is (data) other is (fill in) template. suppose code find all test1 (string) data (tab) used range and paste into (fill in) template of (range of test1). and so till test10 string data.

Sorry if i cannot make the things clear...

Thanks
hameed

[mancubus]

worksheet "fill in" is blank.
please fill in the worksheet "fill in" with the desired output.

[farrukh]

Hi mancubus (http://www.vbaexpress.com/forum/member.php?u=37987),

I have filled the worksheet "FILL_IN" please find attached.


Thanks
hammeed

[mancubus]

your file attached.

changed your table in ws "data"...


Sub test()

Dim wsData As Worksheet, wsFill As Worksheet
Dim cll As Range, rng As Range, r As Range
Dim LastRow As Long, LastCol As Long, i As Long, j As Long, ndx As Long
Dim strLookup As String, FirstAddress As String
Dim copyArr, tempArr, dateArr, tempArr2

Set wsData = Worksheets("DATA")
Set wsFill = Worksheets("FILL_IN")

With wsData
LastRow = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LastCol = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Set rng = .Range("B2:B" & LastRow)
For Each cll In rng
If (cll <> "") And (InStr(tempArr, cll) = 0) Then
tempArr = tempArr & cll & "|"
End If
Next cll
If Len(tempArr) > 0 Then
tempArr = Left(tempArr, Len(tempArr) - 1)
End If
copyArr = Split(tempArr, "|")
j = 3
For ndx = LBound(copyArr) To UBound(copyArr)
.AutoFilterMode = False
.UsedRange.AutoFilter Field:=2, Criteria1:=copyArr(ndx)
With .AutoFilter.Range
On Error Resume Next
Set r = .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2) _
.SpecialCells(xlCellTypeVisible)
'Set r = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1) _
.SpecialCells(xlCellTypeVisible)' to copy the names use this line
On Error GoTo 0
End With
r.Copy Destination:=wsFill.Cells(5, j)
j = j + 16
Next
.AutoFilterMode = False
Set rng = .Range("A2:A" & LastRow)
For Each cll In rng
If (cll <> "") And (InStr(tempArr2, cll) = 0) Then
tempArr2 = tempArr2 & cll & "|"
End If
Next cll
If Len(tempArr2) > 0 Then
tempArr2 = Left(tempArr2, Len(tempArr2) - 1)
End If
dateArr = Split(tempArr2, "|")
wsFill.Cells(5, 1).Resize(UBound(dateArr) + 1, 1) = Application.Transpose(dateArr)
End With

End Sub

[farrukh]

Hi mancubus (http://www.vbaexpress.com/forum/member.php?u=37987),

Fantastic that is exactly i need too, Thank you so much for your time and kind support :)

Regards,
hammeed

[mancubus]

you are wellcome.

please mark the thread as solved from "thread tools".

my assumptions are:
1- the table in worksheet "data" is sorted ascending by column 1 (dates)
2- the table contains all test names (from test1 to test10) for each specific date.

[farrukh]

Hi mancubus (http://www.vbaexpress.com/forum/member.php?u=37987),

Sorry i have to change more in the "FILL_IN" template , you can find the attachement in which i have to add sheets data(Extra_Table1_Data, Extra_Table2_Data etc to "FILL_IN" template each and every time a user find Extra_Table1_Data ,Extra_Table2_Data etc and Data (tab) . find empy. But in "Fill_IN" tempate find last used row and then paste the data.


Sorry to restart the thread...

Thanks
hammeed

[farrukh]

Please close this tread it is greatly solved remove my previous post 11

Thanks
hameed