VBA delete row group if condition met

[dmac101]

Hi All,
I am writing some VBA to take tasks exported from a job system and format so they can be easily imported into msproject.
One are of this where I am stuck is removing closed jobs(they consist of several tasks. I was looking for some vba code that would look down column A until value changes then look at column B for the same number of rows, if all closed in this group then delete rows.
The table that I am using has almost 10000 rows, hence why I want to do it with vba.

A	B
100	closed
100	open
200	closed
200	closed
300	closed
300	closed
300	closed

<tbody>
</tbody>

 

[hiker95]

dmac101,

Welcome to the MrExcel forum.

Here is a macro solution for you to consider, that is based on your flat text display, where the duplicate numbers in column A are grouped together.

The macro will run in the active worksheet.

If you need the macro to run in a specific worksheet, then, what is the worksheet name?

Sample raw data:

Excel 2007
	A	B
1	100	closed
2	100	open
3	200	closed
4	200	closed
5	300	closed
6	300	closed
7	300	closed
8
Sheet1

And, after the macro:

Excel 2007
	A	B
1	100	closed
2	100	open
3
4
5
6
7
8
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub DeleteGroupColA_if_all_colB_Closed()
' hiker95, 05/10/2017, ME1004675
Dim lr As Long, r As Long, n As Long, c As Long
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = 1 To lr
    n = Application.CountIf(.Columns(1), .Cells(r, 1).Value)
    If n = 1 Then
      If .Cells(r, 2) = "Closed" Then
        .Cells(r, 1).Resize(, 2).ClearContents
      End If
    ElseIf n > 1 Then
      c = Application.CountIf(.Range(.Cells(r, 2), .Cells(r + n - 1, 2)), "Closed")
      If n = c Then
        .Range(.Cells(r, 1), .Cells(r + n - 1, 1)).ClearContents
      End If
    End If
    r = r + n - 1
  Next r
  On Error Resume Next
  Range("A1:A" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the DeleteGroupColA_if_all_colB_Closed macro.

 

[dmac101]

Thanks hiker95,
that works great.

if I want to change columns "A" or "B" to other columns, where should I be updating the references in the code?
I tried what I thought were the correct references however it seems to lock up

 

[hiker95]

Thanks hiker95,
that works great.

dmac101,

Thanks for the feedback.

You are very welcome. Glad I could help.

if I want to change columns "A" or "B" to other columns, where should I be updating the references in the code?

Can you supply screenshots of the new raw data worksheet, and, what the results (manually formatted by you) should look like?

 

[dmac101]

Hi Hiker95
I have modified the code as follows:-

Sub DeleteGroupColA_if_all_colB_Closed()
' hiker95, 05/10/2017, ME1004675

Dim lr As Long, r As Long, n As Long, c As Long
With ActiveSheet
  lr = .Cells(Rows.Count, 5).End(xlUp).Row
  For r = 1 To lr
    n = Application.CountIf(.Columns(5), .Cells(r, 5).Value)
    If n = 1 Then
      If .Cells(r, 15) = "Closed" Then
        .Cells(r, 5).Resize(, 15).ClearContents
      End If
    ElseIf n > 1 Then
      c = Application.CountIf(.Range(.Cells(r, 15), .Cells(r + n - 1, 15)), "Closed")
      If n = c Then
        .Range(.Cells(r, 5), .Cells(r + n - 1, 5)).ClearContents
      End If
    End If
    r = r + n - 1
  Next r
  On Error Resume Next
  Range("A1:A" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
End With
 
End Sub

when I run it on the following sheet it deletes the cells in column "E" where the criteria matches instead of all rows where it matchs

Before I run code
Excel 2010

	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Summary	Outline_Level	Task_Mode	Opportunity No	Opportunity Number	Deliverable Number	Name	Resource_Group	Resource_Names	Start	Finish	Actual_Finish	Job type	Duration	Status
2	n	6	Auto Scheduled		10115	job 1	Complete design	Design Team	Fred	########	########	########	house	5	Closed
3	n	6	Auto Scheduled		10115	job 1	Submit plans to Council	Property Team	Jill	########	########	########	house	20	Closed
4	n	6	Auto Scheduled		10115	job 1	Certification	Service Delivery NSW	Dave	########	########	########	house	10	Closed
5	n	6	Auto Scheduled		10115	job 1	customer call	Sales	bob	########	########	########	house	2	Closed
6	n	6	Auto Scheduled		10115	job 2	update paperwork	Admin	bob	########	########	########	house	3	Closed
7	n	6	Auto Scheduled		10115	job 2	Approve contracts	Legal	fred	########	########	########	house	3	Closed
8	n	6	Auto Scheduled		10115	job 2	Acquisition & Stock Control	Stores	jan	########	########	########	house	3	Closed

<tbody>
</tbody>

Sheet1​

After I run code

Excel 2010

	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Summary	Outline_Level	Task_Mode	Opportunity No	Opportunity Number	Deliverable Number	Name	Resource_Group	Resource_Names	Start	Finish	Actual_Finish	Job type	Duration	Status
2	n	6	Auto Scheduled			job 1	Complete design	Design Team	Fred	########	########	########	house	5	Closed
3	n	6	Auto Scheduled			job 1	Submit plans to Council	Property Team	Jill	########	########	########	house	20	Closed
4	n	6	Auto Scheduled			job 1	Certification	Service Delivery NSW	Dave	########	########	########	house	10	Closed
5	n	6	Auto Scheduled			job 1	customer call	Sales	bob	########	########	########	house	2	Closed
6	n	6	Auto Scheduled			job 2	update paperwork	Admin	bob	########	########	########	house	3	Closed
7	n	6	Auto Scheduled			job 2	Approve contracts	Legal	fred	########	########	########	house	3	Closed
8	n	6	Auto Scheduled			job 2	Acquisition & Stock Control	Stores	jan	########	########	########	house	3	Closed
9	n	7	Auto Scheduled		10116	job 3	Acquisition & Stock Control	Stores	feb	########	########	########	house	4	open

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

 

[hiker95]

dmac101,

If I understand your two new screenshots correctly:

1. Your new raw data, Before I run code, contains 8 rows of information?????

2. Your results, After I run code, contains 9 rows of information?????

 

[hiker95]

dmac101,

The macro will run in the active worksheet.

If you need the macro to run in a specific worksheet, then, what is the worksheet name?

If I understand you correctly, then here is another macro solution for you to consider.

Not all columns are shown in order to fit the MrExcel Display Area.

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H	I	L	M	N	O
1	Summary	Outline	Task	Opportunity No	Opportunity Number	Deliverable Number	Name	Resource _Group	Resource _Names	Actual _Finish	Job type	Duration	Status
2	n	6	Auto Scheduled		10115	job 1	Complete design	Design Team	Fred	####	house	5	Closed
3	n	6	Auto Scheduled		10115	job 1	Submit plans to Council	Property Team	Jill	####	house	20	Closed
4	n	6	Auto Scheduled		10115	job 1	Certification	Service Delivery NSW	Dave	####	house	10	Closed
5	n	6	Auto Scheduled		10115	job 1	customer call	Sales	bob	####	house	2	Closed
6	n	6	Auto Scheduled		10115	job 2	update paperwork	Admin	bob	####	house	3	Closed
7	n	6	Auto Scheduled		10115	job 2	Approve contracts	Legal	fred	####	house	3	Closed
8	n	6	Auto Scheduled		10115	job 2	Acquisition & Stock Control	Stores	jan	####	house	3	Closed
9	n	7	Auto Scheduled		10116	job 3	Acquisition & Stock Control	Stores	feb	####	house	4	open
10
Sheet1

And, after the new macro:

Excel 2007
	A	B	C	D	E	F	G	H	I	L	M	N	O
1	Summary	Outline	Task	Opportunity No	Opportunity Number	Deliverable Number	Name	Resource _Group	Resource _Names	Actual _Finish	Job type	Duration	Status
2	n	7	Auto Scheduled		10116	job 3	Acquisition & Stock Control	Stores	feb	####	house	4	open
3
Sheet1

Same instructions as my last reply #2.

Sub DeleteGroupCol_E_if_all_Col_O_Closed()
' hiker95, 05/12/2017, ME1004675
Dim lr As Long, r As Long, n As Long, c As Long
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = 2 To lr
    n = Application.CountIf(.Columns("E:E"), .Cells(r, 5).Value)
    If n = 1 Then
      If .Cells(r, 15) = "Closed" Then
        .Cells(r, 5).ClearContents
      End If
    ElseIf n > 1 Then
      c = Application.CountIf(.Range(.Cells(r, 15), .Cells(r + n - 1, 15)), "Closed")
      If n = c Then
        .Range(.Cells(r, 5), .Cells(r + n - 1, 5)).ClearContents
      End If
    End If
    r = r + n - 1
  Next r
  On Error Resume Next
  .Range("E2:E" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub

Same instructions as my last reply #2.

Then run the DeleteGroupCol_E_if_all_Col_O_Closed macro.

 

[dmac101]

thanks hiker95,
it works great

 

[hiker95]

dmac101,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.