|
Copy and Insert Row
Hi,
The excel vba code does not generate the correct result and incomplete as I've no idea on how to rectify the codes to achieve the intended results Below is the extract of vba codes : - * Dim C As Range * Dim X As Long * Dim LastRowX As Long * Dim LastRowY As Long * Dim CellsToColor() As String * LastRowX = Worksheets("Wrksheet X").Cells(Rows.Count, "A").End (xlUp).Row * LastRowY = Worksheets("Wrksheet Y").Cells(Rows.Count, "A").End (xlUp).Row * With Worksheets("Wrksheet X") * * ReDim CellsToColor(1 To LastRowX) * * For Each C In .Range("A1:A" & LastRowX) * * * If Worksheets("Wrksheet Y").Range("A:A").Find(What:=C.Value, _ * * * * * LookAt:=xlWhole) Is Nothing Then CellsToColor(C.Row) = C.Address * * Next * * .Range("A1:A" & LastRowX).Copy Worksheets("Wrksheet Y").Range ("A1") * * For X = 1 To LastRowX * * * If Len(CellsToColor(X)) 0 Then * * * * .Range(CellsToColor(X)).Cells.Font.Color = vbRed * * * * .Range(CellsToColor(X)).Cells.Font.Bold = True * * * End If * * Next * End With The intended result should copy and paste each row from sheet1 to sheet2 when the ID number is searched and found in column A of sheet2, then highlight changes in red colour E.g. Sheet1 Column A ID No W070124 G081034 C020998 A107390 Sheet2 Column A ID No B090146 A107390 F002955 W070124 Result Column A ID No B090146 A107390 F002955 W070124 Appreciate any helps on the above problem as I'm excel vba beginner Thanks in advance Regards Len |
Copy and Insert Row
On Jan 19, 10:17*pm, Len wrote:
Hi, The excel vba code does not generate the correct result and incomplete as I've no idea on how to rectify the codes to achieve the intended results Below is the extract of vba codes : - * Dim C As Range * Dim X As Long * Dim LastRowX As Long * Dim LastRowY As Long * Dim CellsToColor() As String * LastRowX = Worksheets("Wrksheet X").Cells(Rows.Count, "A").End (xlUp).Row * LastRowY = Worksheets("Wrksheet Y").Cells(Rows.Count, "A").End (xlUp).Row * With Worksheets("Wrksheet X") * * ReDim CellsToColor(1 To LastRowX) * * For Each C In .Range("A1:A" & LastRowX) * * * If Worksheets("Wrksheet Y").Range("A:A").Find(What:=C.Value, _ * * * * * LookAt:=xlWhole) Is Nothing Then CellsToColor(C.Row) = C.Address * * Next * * .Range("A1:A" & LastRowX).Copy Worksheets("Wrksheet Y").Range ("A1") * * For X = 1 To LastRowX * * * If Len(CellsToColor(X)) 0 Then * * * * .Range(CellsToColor(X)).Cells.Font.Color = vbRed * * * * .Range(CellsToColor(X)).Cells.Font.Bold = True * * * End If * * Next * End With The intended result should copy and paste each row from sheet1 to sheet2 when the ID number is searched and found in column A of sheet2, then highlight changes in red colour E.g. Sheet1 Column A ID No W070124 G081034 C020998 A107390 Sheet2 Column A ID No B090146 A107390 F002955 W070124 Result Column A ID No B090146 A107390 F002955 W070124 Appreciate any helps on the above problem as I'm excel vba beginner Thanks in advance Regards Len Sorry.......... There was an error in the example given earlier and the correct example with result should be : - E.g. Sheet1 Column A B C D E ID No Date Intake Name Amount A107390 27/1/2009 KWDU-03 Mr Lim 7600 C020998 23/1/2009 2070-04 Ms Lin 1450 G081034 22/1/2009 WCDU-04 Mr Tan 200 W070124 22/1/2009 KWDU-01 Mr XY 8500 Sheet2 Column A ID No A107390 B090146 F002955 W070124 Result Column A B C D E ID No A107390 27/1/2009 KWDU-03 Ms Lin 7600 B090146 C020998 23/1/2009 2070-04 Mr Lim 1450 F002955 G081034 22/1/2009 WCDU-04 Mr XY 200 W070124 22/1/2009 KWDU-01 Mr Tan 8500 Regards Len |
Copy and Insert Row
On Jan 19, 11:24*pm, "Don Guillett" wrote:
* * * If desired, send your file to my address below. I will only look if: * * * 1. You send a copy of this message on an inserted sheet * * * 2. You give me the newsgroup and the subject line * * * 3. You send a clear explanation of what you want * * * 4. You send before/after examples and expected results. -- Don Guillett Microsoft MVP Excel SalesAid Software "Len" wrote in message ... On Jan 19, 10:17 pm, Len wrote: Hi, The excel vba code does not generate the correct result and incomplete as I've no idea on how to rectify the codes to achieve the intended results Below is the extract of vba codes : - Dim C As Range Dim X As Long Dim LastRowX As Long Dim LastRowY As Long Dim CellsToColor() As String LastRowX = Worksheets("Wrksheet X").Cells(Rows.Count, "A").End (xlUp).Row LastRowY = Worksheets("Wrksheet Y").Cells(Rows.Count, "A").End (xlUp).Row With Worksheets("Wrksheet X") ReDim CellsToColor(1 To LastRowX) For Each C In .Range("A1:A" & LastRowX) If Worksheets("Wrksheet Y").Range("A:A").Find(What:=C.Value, _ LookAt:=xlWhole) Is Nothing Then CellsToColor(C.Row) = C.Address Next .Range("A1:A" & LastRowX).Copy Worksheets("Wrksheet Y").Range ("A1") For X = 1 To LastRowX If Len(CellsToColor(X)) 0 Then .Range(CellsToColor(X)).Cells.Font.Color = vbRed .Range(CellsToColor(X)).Cells.Font.Bold = True End If Next End With The intended result should copy and paste each row from sheet1 to sheet2 when the ID number is searched and found in column A of sheet2, then highlight changes in red colour E.g. Sheet1 Column A ID No W070124 G081034 C020998 A107390 Sheet2 Column A ID No B090146 A107390 F002955 W070124 Result Column A ID No B090146 A107390 F002955 W070124 Appreciate any helps on the above problem as I'm excel vba beginner Thanks in advance Regards Len Sorry.......... There was an error in the example given earlier and the correct example with result should be : - E.g. Sheet1 Column A B C D E ID No Date Intake Name Amount A107390 27/1/2009 KWDU-03 Mr Lim 7600 C020998 23/1/2009 2070-04 Ms Lin 1450 G081034 22/1/2009 WCDU-04 Mr Tan 200 W070124 22/1/2009 KWDU-01 Mr XY 8500 Sheet2 Column A ID No A107390 B090146 F002955 W070124 Result Column A B C D E ID No A107390 27/1/2009 KWDU-03 Ms Lin 7600 B090146 C020998 23/1/2009 2070-04 Mr Lim 1450 F002955 G081034 22/1/2009 WCDU-04 Mr XY 200 W070124 22/1/2009 KWDU-01 Mr Tan 8500 Regards Len Hi Don, Thanks for your reply and I repost the thread to you together with the attached file for your reference Regards Len |
Copy and Insert Row
|
| All times are GMT +1. The time now is 07:10 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com