VBA Help - Adding search button to extract data from another worksheet and pasting associated rows to a different worksheet

[Quynhtly]

Hi,

I am having some trouble with creating coding that would allow me to extract client data from the "Data" worksheet and pasting associated information to a worksheet called "Summary". I have created a button and search function but it seems to fail to pick up any data in the "Data" worksheet - the error message keeps appearing as no data is found.

My aim is to be able to search for a client name. eg John and have all data in column D, H and S copied over to worksheet "Summary" for all rows with "John" in the worksheet "Data".

I want data from worksheet "Data" column D to appear in worksheet "Summary" column B.

I want data from worksheet "Data" column H to appear in worksheet "Summary" column C.

I want data from worksheet "Data" column S to appear in worksheet "Summary" column D.


Below is the coding that i have in place.


Sub AddButton_Click()
Dim iFound
Dim Message$, Title$, Default$, myCode$
Message = "Client Name" ' Set prompt.
Title = "Search Data" ' Set title.
Default = "" ' Set default.
' Display message, title, and default value.
myCode = InputBox(Message, Title, Default)
iFound = False
Application.ScreenUpdating = False
'Check data sheet for data wanted!
Worksheets("Data").Select
For Each r In Worksheets("Data").UsedRange.Columns
n = r.Column
If Worksheets("Data").Cells(1, n) = myCode Then
iFound = True
Worksheets("ALL").Range(Cells(2, n), Cells(4, n)).Copy _
Destination:=Worksheets("Summary").Range("C:65536").End(xlUp).Offset(1, 0)
Else
End If
Next r
If iFound = False Then MsgBox "Error: Data not Found!"
Worksheets("Summary").Select
Application.CutCopyMode = True
Application.ScreenUpdating = True
End Sub


Thanking you in advance.

 

[venkat1926]

try this macro "test" (the second macro "undo" is to undo the result i.e. clear data from sheet3)


no blank rows or columns within the data

Sub test()
Dim r As Range, x As String
x = InputBox("type the name you want for e.g. John")
With Worksheets("data")
Set r = .Range("A1").CurrentRegion

'MsgBox r.Address
With r
.Cells.AutoFilter field:=1, Criteria1:=x
End With
.Cells.SpecialCells(xlCellTypeVisible).Copy
With Worksheets("summary")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
r.AutoFilter
End With
Worksheets("summary").Activate
Range("B1:C1,E1:G1,I1:R1").Select
Selection.EntireColumn.Delete
Range("A1").Select
End Sub

Sub undo()
Worksheets("summary").Cells.Clear
End Sub

check results with sheet "data"

BEFORE USING THE MACROS IN ORIGINAL FILE SAVE ORIGINAL FILE SAFELY SOMEWHERE.