View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Ty Ty is offline
external usenet poster
 
Posts: 72
Default col A,B and C-P moved fr Sheet 1,2, to Sheet 4

On Aug 20, 7:34*pm, Joel wrote:
I was busy today and just got some time to look at this problem. *The code
wasn't difficult. *Simplier than you explanation. I didn't get exactly the
results you posted but the results you posted didn't seem to give consitent
results.

I simply performed the followig steps
1) Copy Columns A and B from sheet 2 to sheet 3
2) Copied header row from sheet 1
3) Looped through each row in sheet 3 looking at the EID in column A
(orignally from sheet 2)
* * a) Found each EID in sheet 1 and copied colums C - H to sheet 3.

Sub Duplicates()
* *'
* *' NOTE: The macro assumes there is a header in the both worksheets
* *' * * * The macro starts at row 2 and sort data automatically
* *'
* *ScreenUpdating = False

* *'copy sheet 2 column A & B to sheet 3
* *With Sheets("Sheet3")
* * * 'clear sheet 3
* * * .Cells.ClearContents

* * * Sheets("Sheet2").Columns("A:B").Copy _
* * * * *Destination:=.Columns("A")

* * * 'copy header row from sheet 1
* * * Sheets("Sheet1").Rows(1).Copy _
* * * * *Destination:=.Rows(1)

* * * RowCount = 2

* * * Do While .Range("A" & RowCount) < ""
* * * * *EID = .Range("A" & RowCount)

* * * * *With Sheets("Sheet1")
* * * * * * Set c = .Columns("A").Find(what:=EID, _
* * * * * * * *LookIn:=xlValues, lookat:=xlWhole)

* * * * * * If Not c Is Nothing Then
* * * * * * * *Set Copyrange = _
* * * * * * * * * .Range(.Range("C" & c.Row), _
* * * * * * * * * * *.Range("H" & c.Row))
* * * * * * * *Copyrange.Copy _
* * * * * * * * * Destination:=Sheets("Sheet3").Range("C" & RowCount)
* * * * * * End If
* * * * *End With
* * * * *RowCount = RowCount + 1
* * * Loop
* *End With

* *ScreenUpdating = True

End Sub



"Ty" wrote:
On Aug 20, 4:25 am, Joel wrote:
Can you post samples of the data you are starting with and the results you
are actaull looking for. *Your description isn't any better the your
prevvious postinggs and without actual data I don't think you will get the
results you are looking for.


My previous code worked except you where unhappy with the column b data that
was put in the destination sheet. *Sheet 1 column B didn't have the data you
were looking for. *You wanted my to put the sheet 2 column B data into column
B in the destination sheet. *But column B in sheet 2 had various didfferent
results.


People should read your previous posting before trying to solve this problem


http://www.microsoft.com/office/comm....mspx?&query=T....


This is the results I think will work from my previous posting


Sub Duplicates()
* *'
* *' NOTE: The macro assumes there is a header in the both worksheets
* *' * * * The macro starts at row 2 and sort data automatically
* *'
* *ScreenUpdating = False


* *'copy sheet 1 to sheet 3
* *With Sheets("Sheet3")
* * * Sheets("Sheet1").Cells.Copy _
* * * * *Destination:=.Cells


* * * 'find last row
* * * LastRowA = .Range("A" & Rows.Count).End(xlUp).Row
* * * LastRowB = .Range("B" & Rows.Count).End(xlUp).Row


* * * If LastRowA LastRowB Then
* * * * *LastRow = LastRowA
* * * Else
* * * * *LastRow = LastRowB
* * * End If


* * * NewRow = LastRow + 1


* * * With Sheets("Sheet2")
* * * * *'find last row
* * * * *LastRow2 = .Range("A" & Rows.Count).End(xlUp).Row
* * * End With


* * * 'copy sheet 2 to end of sheet 3, only columns A & B
* * * Sheets("Sheet2").Range("A1:B" & LastRow2).Copy _
* * * * *Destination:=.Range("A" & NewRow)


* * * 'Sort Data
* * * LastRow = .Range("A" & Rows.Count).End(xlUp).Row
* * * .Rows("1:" & LastRow).Sort _
* * * * *header:=xlYes, _
* * * * *Key1:=.Range("A1"), _
* * * * *order1:=xlAscending


* * * 'Mark row which aren't duplicates so they can be removed


* * * RowCount = 3
* * * Do While .Range("A" & RowCount) < ""
* * * * *'check if ID matches either previous or next row
* * * * *If .Range("A" & RowCount) < .Range("A" & (RowCount - 1)) And _
* * * * * * .Range("A" & RowCount) < .Range("A" & (RowCount + 1)) Then


* * * * * * .Range("IV" & RowCount) = "X"


* * * * *End If
* * * * *RowCount = RowCount + 1
* * * Loop


* * * 'put anything in cell IV1 so filter works properly
* * * .Range("IV1") = "Anything"
* * * 'filter on x's
* * * .Columns("IV:IV").AutoFilter
* * * .Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"


* * * Set VisibleRows = .Rows("2:" & LastRow) _
* * * * *.SpecialCells(xlCellTypeVisible)
* * * 'delete rows with X's
* * * VisibleRows.Delete
* * * 'turn off autfilter
* * * .Columns("IV:IV").AutoFilter
* * * 'clear IV1
* * * .Range("IV1").Clear


* *End With


* *ScreenUpdating = True


End Sub


"Ty" wrote:
I have received plenty of help from here with several macro's
attempting to solve my problem. *But the problem was never resolved.
Most of it is my fault. *After reviewing the macro's and my original
description of my problem, I am trying to make another post that might
actually solve my problem. *The last attempt worked ok except for the
fact I left part of the end results of the previous macro on my sheet
1. *(read below) After the sort, it was reading the data at the bottom
of sheet 1:col B and placing it on Sheet 4. *And that data was used to
come up with a solution. *When I deleted the data:Col B from the other
Macro, there was no Col B data on Sheet 4 when the final macro(below)
was ran. *After chatting with one of the MVP's. *Here is what I need:


VLookup will not work because it will only return 1 item. *I have
multiple items for 1 match in most cases. *Example: *1 employee might
have 4 id's. *I have a file if someone wants it.


For each item in *col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all)="that cell"="that item" of
the row:col B of Sheet2 copied to Col B sheet 4. Etc I then want?


This is the tricky part:
For each item in *col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all) of the row:col C to col P
of Sheet1 copied to sheet 3.


In other words:


I want info from sheet 1 cells in Col A that match cells A:B in Sheet
2_____ to be put *in sheet 4.


I want info from sheet 1 cells in Col C to Col P that match cells A:
in Sheet 4_____ to be put *in sheet 4 where? in col C to col P.


Here is the last piece of code but I know everyone writes differently:


Option Explicit
Sub MakeDestinationSheet()
Dim n
Dim c
Dim lr, slr, ifshtlr As Long
Dim srcsht, ifsht, destsht As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


Set srcsht = Sheets("sheet1")
Set ifsht = Sheets("sheet2")
ifshtlr = ifsht.Cells(Rows.Count, 1).End(xlUp).Row


Set destsht = Sheets("Sheet4")
destsht.Select


With destsht
lr = .Cells(Rows.Count, 1).End(xlUp).Row
..Rows(2).Resize(lr).Delete


For Each n In ifsht.Range("a2:a" & ifshtlr)
Set c = destsht.Columns(1).Find(n, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If c Is Nothing Then
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
With srcsht.Range("A4:p" & slr)
* * .AutoFilter Field:=1, Criteria1:=n
lr = destsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
srcsht.Range("a5:p" & slr).Copy destsht.Cells(lr, 1)
..AutoFilter
End With


End If
Next n
*.Range(Cells(2, "c"), Cells(lr + 1, "p")).SpecialCells
(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
*.Range(Cells(2, "j"), Cells(lr + 1, "k")).NumberFormat = "mm/dd/yyyy"
*.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value = _
*.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value
*.Columns("b").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
*.Columns("L").Style = "Comma"
*.Columns.AutoFit


End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Warm regards,
Ty- Hide quoted text -


- Show quoted text -


First, thanks for the help. *Here are some samples of the data. *It's
difficult to place the data in .txt in here. *I used the comma so you
can Import it into Excel using the "," as a delimiter. *The ",," are
blank cells. *In most lines down below, ",," is the ColB. Just fyi--
down below the fullname has a comma in 1 full cell on the original SS-
spreadsheet. *The real columns on Sheet 1 go all the way to Col P and
sometimes more. *The rows could go up to 55,000. *I hope this is a
little more clear so the problem can be resolved.


The code listed in the initial posting & response is displaying the
output equal to Sheet 4(Current Macro results). Cell on Col B on the
same line as the Col C:P information is blank(",,").


Sheet1
EID,TSECRET,EmployeeId,Lawid,SSN-4,Associate,EmployeeName
VXK031,,104852,,1733,Y,Dunn,Robert J.
QEM893,,127901,,5011,Y,Racker,Doretta S.
SPE533,,128194,,2462,Y,Son,Richard T
LAF321,,161631,,016A,N,Well,Mark Adam
XMA505,,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
YEQ957,,388869,,8887,Y,Frazier,Verlon Jo
ZKB886,,288837,,7883,Y,Smith,Sandra Mott


Sheet2
Eid,TSecret
XMA505,XMA505P,XAUTREAY, TRAVIS S
XMA505,E018864
YEQ957,YEQ957N,FRAZIER, VERLON J
YEQ957,YEQ957T
ZKB886,ZKB886N,Smith, SANDRA M
ZKB886,ZKB886P
ZKB886,ZKB886T


Sheet4: Finished(Manually done by hand). *Here is what is what I


...

read more »- Hide quoted text -

- Show quoted text -


I used it on several spreadsheets. Thanks for the help.