PC Review


Reply
Thread Tools Rate Thread

Beginner: Compare cells, if they have same value, then copy the ro

 
 
Steffen Sørdal
Guest
Posts: n/a
 
      19th Feb 2010
Hi,

I am newbie to VBA, and need help to accomplish:

In a sheet I need to compare the cells in row E (row E is sorted
alphabetically), to see if they have the same value. It can be up to 10 rows
with the same value. (the whole sheet contains <1500 rows)

If they are the same, those rows with samy value in column E shall be copied
to another sheet.
This is just a part of the makros that are running.

As said, I am a newbie, but does this do something?
(Earlier in the makro there is
Dim x
x = 1)

Sheets("Skatteseddel").Select

Dim k
k = 1

If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1
If Range("E" & x) = ("E" & "x + k") Then k = k + 1

Sheets("Skatteseddel").Select
Rows(x,x+k).Select
Selection.Copy

Can someone please help?

--
Regards,
Steffen
--
Regards,
Steffen
 
Reply With Quote
 
 
 
 
Jacob Skaria
Guest
Posts: n/a
 
      19th Feb 2010
Check out the below macro

Sub MyMacro()
Dim ws As Worksheet, lngRow As Long, lngStart As Long

Set ws = Sheets("Skatteseddel")
lngStart = 2 'Row where data starts

For lngRow = lngStart + 1 To ws.Cells(Rows.Count, "E").End(xlUp).Row + 1
If ws.Range("E" & lngRow) <> ws.Range("E" & lngRow + 1) Then
ws.Rows(lngStart & ":" & lngRow).Select

'OR
'ws.Rows(lngStart & ":" & lngRow).Copy

lngStart = lngRow + 1
End If
Next

End Sub

--
Jacob


"Steffen Sørdal" wrote:

> Hi,
>
> I am newbie to VBA, and need help to accomplish:
>
> In a sheet I need to compare the cells in row E (row E is sorted
> alphabetically), to see if they have the same value. It can be up to 10 rows
> with the same value. (the whole sheet contains <1500 rows)
>
> If they are the same, those rows with samy value in column E shall be copied
> to another sheet.
> This is just a part of the makros that are running.
>
> As said, I am a newbie, but does this do something?
> (Earlier in the makro there is
> Dim x
> x = 1)
>
> Sheets("Skatteseddel").Select
>
> Dim k
> k = 1
>
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
>
> Sheets("Skatteseddel").Select
> Rows(x,x+k).Select
> Selection.Copy
>
> Can someone please help?
>
> --
> Regards,
> Steffen
> --
> Regards,
> Steffen

 
Reply With Quote
 
Ryan H
Guest
Posts: n/a
 
      19th Feb 2010
This code should do what you are wanting. I assumed you have a header row in
sheet Skatteseddel and your copy sheet. You will have to name the sheet
where you want the copied rows to go to, I assumed "Sheet2". Just change the
sheet name in the row indicated below with the >>>> next to it. Hope this
helps! If so, let me know, click "YES" below.

Sub CopyRows()

Dim wksSource As Worksheet
Dim wksCopy As Worksheet
Dim LastRow As Long
Dim rw As Long
Dim FirstRow As Long
Dim FinalRow As Long

Set wksSource = Sheets("Skatteseddel")
>>> Set wksCopy = Sheets("Sheet2")


With wksSource
LastRow = .Cells(Rows.Count, "E").End(xlUp).Row
For rw = 1 To LastRow
If .Cells(rw, "E").Value = .Cells(rw + 1, "E").Value Then
FirstRow = rw
FinalRow = rw
Do Until .Cells(FirstRow, "E").Value <> .Cells(FinalRow,
"E").Value
FinalRow = FinalRow + 1
Loop
.Rows(FirstRow & ":" & FinalRow - 1).Copy _
Destination:=wksCopy.Range("A" &
wksCopy.Cells(Rows.Count, "A").End(xlUp).Row + 1)
rw = FinalRow - 1
End If
Next rw
End With

End Sub
--
Cheers,
Ryan


"Steffen Sørdal" wrote:

> Hi,
>
> I am newbie to VBA, and need help to accomplish:
>
> In a sheet I need to compare the cells in row E (row E is sorted
> alphabetically), to see if they have the same value. It can be up to 10 rows
> with the same value. (the whole sheet contains <1500 rows)
>
> If they are the same, those rows with samy value in column E shall be copied
> to another sheet.
> This is just a part of the makros that are running.
>
> As said, I am a newbie, but does this do something?
> (Earlier in the makro there is
> Dim x
> x = 1)
>
> Sheets("Skatteseddel").Select
>
> Dim k
> k = 1
>
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
> If Range("E" & x) = ("E" & "x + k") Then k = k + 1
>
> Sheets("Skatteseddel").Select
> Rows(x,x+k).Select
> Selection.Copy
>
> Can someone please help?
>
> --
> Regards,
> Steffen
> --
> Regards,
> Steffen

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro to compare and copy ranges of cells Vanessa Microsoft Excel Programming 4 17th Jan 2011 10:23 PM
Compare cells and copy columns after match Kcope8302 Microsoft Excel Worksheet Functions 2 5th Aug 2009 05:37 PM
compare cells, copy, loop Immortal_Creations Microsoft Excel Worksheet Functions 2 17th Jul 2009 03:34 PM
compare 2 cells then copy value if they are different Gwen B Microsoft Excel Misc 6 15th May 2009 05:44 PM
compare 2 cells then copy value if they are different Gwen B Microsoft Excel Misc 0 15th May 2009 03:08 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 04:04 AM.