MSGROUPS.NET | Search | Post Question | Groups | Stream | About | Register

### Copy and Insert Row

• Follow

```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 : -

=A0 Dim C As Range
=A0 Dim X As Long
=A0 Dim LastRowX As Long
=A0 Dim LastRowY As Long
=A0 Dim CellsToColor() As String
=A0 LastRowX =3D Worksheets("Wrksheet X").Cells(Rows.Count, "A").End
(xlUp).Row
=A0 LastRowY =3D Worksheets("Wrksheet Y").Cells(Rows.Count, "A").End
(xlUp).Row
=A0 With Worksheets("Wrksheet X")
=A0 =A0 ReDim CellsToColor(1 To LastRowX)
=A0 =A0 For Each C In .Range("A1:A" & LastRowX)
=A0 =A0 =A0 If Worksheets("Wrksheet Y").Range("A:A").Find(What:=3DC.Value, =
_
=A0 =A0 =A0 =A0 =A0 LookAt:=3DxlWhole) Is Nothing Then CellsToColor(C.Row) =
=3D
=A0 =A0 Next
=A0 =A0 .Range("A1:A" & LastRowX).Copy Worksheets("Wrksheet Y").Range
("A1")
=A0 =A0 For X =3D 1 To LastRowX
=A0 =A0 =A0 If Len(CellsToColor(X)) > 0 Then
=A0 =A0 =A0 =A0 .Range(CellsToColor(X)).Cells.Font.Color =3D vbRed
=A0 =A0 =A0 =A0 .Range(CellsToColor(X)).Cells.Font.Bold =3D True
=A0 =A0 =A0 End If
=A0 =A0 Next
=A0 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

Regards
Len

```
 0

```On Jan 19, 10:17=A0pm, Len <ltong2000...@yahoo.co.uk> 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 : -
>
> =A0 Dim C As Range
> =A0 Dim X As Long
> =A0 Dim LastRowX As Long
> =A0 Dim LastRowY As Long
> =A0 Dim CellsToColor() As String
> =A0 LastRowX =3D Worksheets("Wrksheet X").Cells(Rows.Count, "A").End
> (xlUp).Row
> =A0 LastRowY =3D Worksheets("Wrksheet Y").Cells(Rows.Count, "A").End
> (xlUp).Row
> =A0 With Worksheets("Wrksheet X")
> =A0 =A0 ReDim CellsToColor(1 To LastRowX)
> =A0 =A0 For Each C In .Range("A1:A" & LastRowX)
> =A0 =A0 =A0 If Worksheets("Wrksheet Y").Range("A:A").Find(What:=3DC.Value=
, _
> =A0 =A0 =A0 =A0 =A0 LookAt:=3DxlWhole) Is Nothing Then CellsToColor(C.Row=
) =3D
> =A0 =A0 Next
> =A0 =A0 .Range("A1:A" & LastRowX).Copy Worksheets("Wrksheet Y").Range
> ("A1")
> =A0 =A0 For X =3D 1 To LastRowX
> =A0 =A0 =A0 If Len(CellsToColor(X)) > 0 Then
> =A0 =A0 =A0 =A0 .Range(CellsToColor(X)).Cells.Font.Color =3D vbRed
> =A0 =A0 =A0 =A0 .Range(CellsToColor(X)).Cells.Font.Bold =3D True
> =A0 =A0 =A0 End If
> =A0 =A0 Next
> =A0 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
>
>
> 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

```
 0

```      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
dguillett@gmail.com
"Len" <ltong2000mal@yahoo.co.uk> wrote in message
On Jan 19, 10:17 pm, Len <ltong2000...@yahoo.co.uk> 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) =
> 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
>
>
> 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

```
 0

```On Jan 19, 11:24=A0pm, "Don Guillett" <dguille...@austin.rr.com> wrote:
> =A0 =A0 =A0 If desired, send your file to my address below. I will only l=
ook if:
> =A0 =A0 =A0 1. You send a copy of this message on an inserted sheet
> =A0 =A0 =A0 2. You give me the newsgroup and the subject line
> =A0 =A0 =A0 3. You send a clear explanation of what you want
> =A0 =A0 =A0 4. You send before/after examples and expected results.
>
> --
> Don Guillett
> Microsoft MVP Excel
> SalesAid Software
> dguill...@gmail.com"Len" <ltong2000...@yahoo.co.uk> wrote in message
>
> On Jan 19, 10:17 pm, Len <ltong2000...@yahoo.co.uk> 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 =3D Worksheets("Wrksheet X").Cells(Rows.Count, "A").End
> > (xlUp).Row
> > LastRowY =3D 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:=3DC.Value, _
> > LookAt:=3DxlWhole) Is Nothing Then CellsToColor(C.Row) =3D
> > Next
> > .Range("A1:A" & LastRowX).Copy Worksheets("Wrksheet Y").Range
> > ("A1")
> > For X =3D 1 To LastRowX
> > If Len(CellsToColor(X)) > 0 Then
> > .Range(CellsToColor(X)).Cells.Font.Color =3D vbRed
> > .Range(CellsToColor(X)).Cells.Font.Bold =3D 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
>
>
> > 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,

Regards
Len
```
 0

```Didn't see it...
--
Don Guillett
Microsoft MVP Excel
SalesAid Software
dguillett@gmail.com
"Len" <ltong2000mal@yahoo.co.uk> wrote in message
On Jan 19, 11:24 pm, "Don Guillett" <dguille...@austin.rr.com> 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
> dguill...@gmail.com"Len" <ltong2000...@yahoo.co.uk> wrote in message
>
> On Jan 19, 10:17 pm, Len <ltong2000...@yahoo.co.uk> 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) =
> > 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
>
>
> > 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,

Regards
Len

```
 0

4 Replies
241 Views

Similiar Articles:

7/8/2012 8:16:19 PM