View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default VLOOKUP Insert & Copy

The best way of doing this is to copy sheet1 to sheet 3. Then add sheet 2 to
end of sheet 3. Next sort sheet 3 by column A.

Now we must get rid of non duplicates. So I check if the column A data
match the next and previous rows and place an X in Column IV. So column IV
now contains an X on the rows to delete. I use autofilter to get only the
X's and delete these rows. See code below.


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
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
End With

'copy sheet 2 to end of sheet 3
Sheets("Sheet2").Rows("1:" & LastRow).Copy _
Destination:=.Rows(NewRow)

'Sort Data
.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:

On Aug 12, 6:22 am, Joel wrote:
Can you be a little more specifc. I'm not sure which code you need modified.
Repost what you want modified with the description of the change in To/From
format.



"Ty" wrote:
On Aug 11, 9:20 pm, Joel wrote:
there are a million different ways to do comparisons like this. Everybody
wants something a little dfifferent. Pardon me if I didn't interprete you
request properly. I think you want columns C - H on sheet 1 put on sheet 2
columns C - H. What is confusing me is your previous request ask for the
data to be placed either on sheet 1 or sheet 3. Now it is sheet 2. If it is
wrong in only takes me 2 minutes to make the changes. No big deal.


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


'find matching rows in sheet 2
With Sheets("Sheet2")
RowCount = 2
Do While .Range("A" & RowCount) < ""
ID = Trim(.Range("A" & RowCount))
'compare - look for ID in Sheet 1
With Sheets("Sheet1")
Set c = .Columns("A").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)


If Not c Is Nothing Then
'copy sheet 1 to sheet 2
Set CopyRange = _
.Range("C" & c.Row & ":H" & c.Row)
CopyRange.Copy Destination:=Sheets("Sheet2").Range("C" &
RowCount)
End If
End With
RowCount = RowCount + 1
Loop
End With


ScreenUpdating = True


End Sub


"Ty" wrote:
On Aug 11, 4:19 pm, Joel wrote:
I can easily do any or all of three things below:


1) Highlight the dups on Sheet 2
2) Put duplicates on sheet 3
3) If column B on sheet 1 has more data than A add the dups to sheet 1
starting after the LastRow in either A or b. Then sort on A. I can leave
the rows without column A data at the beginning or end of Sheet 1..


"Ty" wrote:
On Aug 11, 11:54 am, Joel wrote:
the IDs are not eactly matching. This is usually caused by extra spaces in
the strings or some of the letters are in uppercase. Try these changes.. I
added MatchCase = False and added TRIM in two locations. The code is looking
for an exact match in ID which means it is checking the entire cell to match.


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


'get first empty row of sheet1
With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
End With


'find matching rows in sheet 2
With Sheets("Sheet2")
RowCount = 2
Do While .Range("A" & RowCount) < ""
ID = trim(.Range("A" & RowCount))
Employee = trim(.Range("B" & RowCount))
'compare - look for ID in Sheet 1
With Sheets("Sheet1")
Set c = .Columns("A").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole,MatchCase:=False)
If Not c Is Nothing Then
'add to end of sheet 1
.Range("A" & NewRow) = ID
.Range("B" & NewRow) = Employee
NewRow = NewRow + 1
End If
End With


RowCount = RowCount + 1
Loop
End With


'sort and highlight data
RowCount = 2
With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'sort data by column A
.Rows("1:" & LastRow).Sort _
header:=xlYes, _
Key1:=.Range("A1"), _
order1:=xlascendiing


Do While .Range("A" & RowCount) < ""
Set FirstItem = .Range("A" & RowCount)
Set SecondItem = .Range("A" & (RowCount + 1))
If FirstItem.Value = SecondItem.Value Then
FirstItem.Interior.Color = RGB(255, 0, 0)
SecondItem.Interior.Color = RGB(255, 0, 0)
End If


RowCount = RowCount + 1
Loop
End With
ScreenUpdating = True


End Sub


"Ty" wrote:
On Aug 11, 6:11 am, Joel wrote:
The code below assumes theree is a header row. It is much quicker to add
data to empty rows at the end of the worksheet then to insert rows in the
middle of a worksheet. The code adds duplicate items from sheet 2 to sheet 1
at the end of sheet 1. Then sorts sheets 1 by column A. finally the code
highlights the duplicate rows in sheet 1.


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


'get first empty row of sheet1
With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
End With


'find matching rows in sheet 2
With Sheets("Sheet2")
RowCount = 2
Do While .Range("A" & RowCount) < ""
ID = .Range("A" & RowCount)
Employee = .Range("B" & RowCount)
'compare - look for ID in Sheet 1
With Sheets("Sheet1")
Set c = .Columns("A").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
'add to end of sheet 1
.Range("A" & NewRow) = ID
.Range("B" & NewRow) = Employee
NewRow = NewRow + 1
End If
End With


RowCount = RowCount + 1
Loop
End With


'sort and highlight data
RowCount = 2
With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'sort data by column A
.Rows("1:" & LastRow).Sort _
header:=xlYes, _
Key1:=.Range("A1"), _
order1:=xlascendiing


Do While .Range("A" & RowCount) < ""
Set FirstItem = .Range("A" & RowCount)
Set SecondItem = .Range("A" & (RowCount + 1))
If FirstItem.Value = SecondItem.Value Then
FirstItem.Interior.Color = RGB(255, 0, 0)
SecondItem.Interior.Color = RGB(255, 0, 0)
End If


RowCount = RowCount + 1
Loop
End With
ScreenUpdating = True


End Sub


"Ty" wrote:
I have several postings. All of the answers solved my problem. Here
is another problem that I can't resolve with just VLOOKUP. VLOOKUP
only grabs the first line of data from the other sheet.


I'm trying to use the same VB script from my first post(down below)..
I need to look at Sheet #2 in comparison to Sheet #1. Whenever col
1:sheet2 has matching data, then sheet #1 need to INSERT ROW and copy
sheet2:column 2:cell data to sheet1:column2 plus sheet2:column1:cell
data to sheet1:column1. All changes will be made on Sheet #1 after
viewing Sheet #2.


More detail:
col 1 in both sheets will have the same type of data. Example: last 4
SSN.


sheet1
col A
2255
3322
1134
8844


col B
blank


Sheet2
col A
2255
2255
2255


col B
Ty
Lincoln
Tony


Sub Duplicates()
'
' NOTE: You must select the first cell in the column and
' make sure that the column is sorted before running this macro
'
ScreenUpdating = False
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1, 0).Value
Offsetcount = 1
Do While ActiveCell < ""
If FirstItem =


...

read more ยป- Hide quoted text -

- Show quoted text -


Hope you are in the best of moods today. I really apologize for all
of the confusion. I don't want to repeat what I said before because I
have a better understanding of what needs to be done. Manually, I was
doing inserts/copy/paste. It is difficult to do inserts. Not
impossible but difficult. I'm gonna follow your logic for the code.
What you did on the first code was ok except for the following:

On sheet 1 when your first code was done. The changes on Sheet 1 were
one line below the original data on Sheet 1. Example:

One way of visually showing the SS:
ColA ColB ColC
ID1 blank cell [all of the data from Col C to Col H(actually P)]
ID1 data(from Sheet2) [no data]
ID1 data(from Sheet2) [no data]

Another way of visually representing the SS:
Row 2: ColA=ID1 ColB=blank cell ColC:ColH=[all of the data from Col
C to Col H(actually P)]
Row 3: ColA=ID1 ColB=data(from Sheet2) ColC:ColH=[no data]
Row 4: ColA=ID1 ColB=data(from Sheet2) ColC:ColH=[no data]

After the sort is done, there is essentially 1 extra ID/Employee being
displayed because you have the original id on Sheet 1 and the end
result of the code. Manually, I was just inputting the Data from
Sheet 2 in the blank cell. Then ONLY if there was extra Data I was
inserting a row and inputting the other 2 or 3 cells/rows.

So, basically Row 3-4 is the end results of the code. Which is
GREAT! I just wanted those results to include [all of the data from
Col C to Col P]. If possible, ONLY place the end results on Sheet 3
with the Sheet1: ColC:ColP data matching each id.

If that is not clear, I will try to answer your questions first before
you display code.

Again, Thank you.