Selecting Cell based on a criteria and copy selected row [Closed]

Posts
23
Registration date
Monday October 15, 2012
Status
Member
Last seen
August 18, 2016
- - Latest reply: Debs269
Posts
23
Registration date
Monday October 15, 2012
Status
Member
Last seen
August 18, 2016
- Apr 1, 2014 at 04:21 AM
Hello,


I am working on VBA for the following

Selecting cell based on criteria and the copying the selected row to another sheet. Then deleting the orginal row from master sheet.


The criteria is "Completed on System" and information in column B (starting at row12).
The Row is A:AC

There are three seperate sheets I need to identify the data on
"WhiteHillMaster" "GloryParkMaster" and WentworthMaster"

need to identify all the "Completed on System" on each sheet


Rows being copied to "DataMaster"

The script needs to find the next avaialble row in the "DataMaster" sheet

Copy the values and formats (not the Forumlas)

Then delete the row from the original sheet


Can anyone advise...please

Many Thanks in advance









See more 

3 replies

Posts
2521
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 9, 2019
363
0
Thank you
Here you go Debs:
Sub RunMe()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "DataMaster" Then
Sheets(ws.Name).Select
For Each cell In Range("B12:B" & Cells(Rows.Count, "B").End(xlUp).Row)
If cell.Value = "Completed on System" Then
Range(Cells(cell.Row, "A"), Cells(cell.Row, "AC")).Copy
Sheets("DataMaster").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("DataMaster").Range("A" & Rows.Count).End(xlUp).PasteSpecial Paste:=xlPasteFormats
End If
Next cell
End If
Next ws

For Each ws In Worksheets
If ws.Name <> "DataMaster" Then
Sheets(ws.Name).Select
For Each cell In Range("B12:B" & Cells(Rows.Count, "B").End(xlUp).Row)
If cell.Value = "Completed on System" Then
Range(Cells(cell.Row, "A"), Cells(cell.Row, "AC")).Delete
End If
Next cell
End If
Next ws

End Sub

It's not the shortest structure but it will do the job.

Best regards,
Trowa

Monday, Tuesday and Thursday are usually the days I'll respond. Bear this in mind when awaiting a reply.
Posts
23
Registration date
Monday October 15, 2012
Status
Member
Last seen
August 18, 2016
2
0
Thank you
Thanks TrowD for your response..

All seem fine until I run

Comes up with "subscript out of range"

All looks ok, so not sure what I have done..

BTW thank you so much for looking at this today, really appreciate the help.

Many Thanks
Debs
TrowaD
Posts
2521
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 9, 2019
363 -
On what line do you get the error (the yellow line)?
Posts
23
Registration date
Monday October 15, 2012
Status
Member
Last seen
August 18, 2016
2
0
Thank you
On Line

If ws.Name <> "DataMaster" Then

Sheets(ws.name).Select

For Each Cell In Range("C12:C" & Cells(Rows.Count, "C").End(xlUp).Row)

If Cell.Value = "Completed on System" Then

Range(Cells(Cell.Row, "A"), Cells(Cell.Row, "AC")).Copy

Sheets("DataMaster").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Sheets("DataMaster").Range("A" & Rows.Count).End(xlUp).PasteSpecial Paste:=xlPasteFormats

End If

Next Cell

I changed ws.name to WhiteHIllMaster .. assumed that was correct
TrowaD
Posts
2521
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 9, 2019
363 -
So I guess the line "If ws.Name <> "DataMaster" Then" turned yellow. Can't think of a reason why, but you weren't supposed to change ws.name into anything.

The code loops through all sheets, if the sheets name is DataMaster then don't do anything. To refer to the other sheets, I use the name Excel finds for every other sheet. To do that I use ws.name.

If you change ws.name into WhiteHIllMaster then only that sheet will be handled.

To find the reason for the error I will need to look at your file, which you can upload using a filesharing site like www.speedyshare.com or ge.tt and then post back the download link. Just be careful with personal/private information.

Best regards,
Trowa
Debs269
Posts
23
Registration date
Monday October 15, 2012
Status
Member
Last seen
August 18, 2016
2 -
Thanks will try this... appreciate your help again

Debs