Menu
  1. Accueil
  2. Forum
  3. Office Software
  4. Excel

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

Report
Posts
23
Registration date
Monday October 15, 2012
Status
Member
Last seen
August 18, 2016
 -
Debs269
Posts
23
Registration date
Monday October 15, 2012
Status
Member
Last seen
August 18, 2016
 -
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

Answer 1 / 3
Posts
2591
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
February 11, 2020
 396
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.
Answer 2 / 3
Posts
23
Registration date
Monday October 15, 2012
Status
Member
Last seen
August 18, 2016
 2
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
Report
TrowaD
Posts
2591
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
February 11, 2020
 396
On what line do you get the error (the yellow line)?
Answer 3 / 3
Posts
23
Registration date
Monday October 15, 2012
Status
Member
Last seen
August 18, 2016
 2
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
Report
TrowaD
Posts
2591
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
February 11, 2020
 396
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
Report
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
Ask a question