On Friday, December 21, 2012 7:32:03 PM UTC-8, Patrick Johnson wrote:
Ben McClave;1608161 Wrote:
Patrick,
I think that the macro below will do the trick with one small change to
your sample workbook. The change I made was to put all the headers in
row 1 and start the data in row 2 of the Main tab. With these changes,
the following code should work out.
Ben
Sub CopyName()
Dim wsMain As Worksheet 'Main Worksheet
Dim wsFound As Worksheet 'John Doe Worksheet
Dim wsOther As Worksheet 'Not John Worksheet
Dim strName As String 'Name to search
Set wsMain = Sheet1 'Sheets ("Main")
Set wsFound = Sheet2 'Sheets ("John Doe")
Set wsOther = Sheet3 'Sheets ("Not John")
strName = "John Doe"
strName = InputBox("Please enter a name", "Name?", strName)
'Inserts criteria on Main sheet, then uses advanced filter to populate
'other sheets. Afterwards, criteria row is deleted.
'Assumes all headers started in row 1 and data starts in row 2
With wsMain
.Range("1:4").Insert
.Range("A1").Value = .Range("A5").Value
.Range("A2").Value = strName
wsFound.Range("A1:E1").Value = .Range("A5:E5").Value
wsOther.Range("A1").Value = .Range("A5").Value
.Range("A5").CurrentRegion.AdvancedFilter xlFilterCopy,
.Range("A1:A2"), _
wsFound.Range("A1:E1"), False
.Range("A2").Value = "'<" & strName
.Range("A5").CurrentRegion.AdvancedFilter xlFilterCopy,
.Range("A1:A2"), _
wsOther.Range("A1"), False
.Range("1:4").Delete
End With
Set wsMain = Nothing
Set wsFound = Nothing
Set wsOther = Nothing
End Sub
Apparently my knowledge on macros is nil.
I am sure it works for someone with some macro knowledge. I however
found a formula that does what I want it to do except it doubles each
entry which is annoying.
The formula is
=vlookup($A$1,Main!$Ax:$E$8,COLUMN(),FALSE)
$A$1 is the A1 cell where i have the name I want to have posted to the
sheet
Main is the main book with raw data
$Ax is the A Column x number of rows I select to search
$E$8 is the length and width of data i want to be copied
COLUMN I have no idea what this is for
FALSE searches for John Doe only.
Attached is the new xls sheet with three different ways of putting
"$Ax:$E$8" trying to have it copy the row ONCE. and you'll see what i
mean by it copying it down twice. thank you again for your help!
+-------------------------------------------------------------------+
|Filename: Book2.zip |
|Download: http://www.excelbanter.com/attachment.php?attachmentid=713|
+-------------------------------------------------------------------+
--
Patrick Johnson
Hi Patrick,
I'd be suprised if Ben's code doesn't do what you want. However, I put this code in the worksheet Main
vb editor. I selected A3:E8 on worksheet Main and in the name box named it DataA. Next I entered John Doe in A1 of worksheet Main. I assigned the sub to a button on worksheet Main. Click the button and the following "John Doe info" is transfered to F2:J4 on John Doe worksheet.
Code:
John Doe 100 1000 200 300
John Doe 300 3000 400 500
John Doe 500 5000 600 700
Code:
Option Explicit
Sub DataA()
Dim i As Variant
Dim DataA As Range
Dim c As Range
Application.ScreenUpdating = False
i = Range("A1").Value
For Each c In Range("DataA")
If c.Value = i Then
c.Resize(1, 5).Copy
Sheets("John Doe").Range("F10").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Good luck.
Regards,
Howard