VBA to delete range between 2 used ranges.

[ngochien251088]

Hi Everybody,

I would like to seek your help deleting blank rows between 2 used ranges.
I expect to remove the blank rows between the last rows of the used range 1 ( row 56) and the first row of the used range 2 ( row 73).
Another thing is I don't want to remove the blank row between the used rows of range 1, due to it helps to separate each items.
Because there are many sheets and the used range rows are not fixed so I can not write to code by myself.
I am a newbie in VBA.
Thank you very much for your help. Any ideas are appreciated.

Book1
	A	B	C	D	E	F	G	H	I	J
1			MULTI LABEL
2
3			ITEM #:	1		37	PACKS
4			VPC #:	505-S212-0103
5			DESCRIPTION:	Paper Adhsv Address Labels 1 x 2-5/8, 1000 SHT
6			TOTAL:	37	CARTONS
7
8			ITEM #:	1		20	PACKS
9			VPC #:	505-S212-0104
10			DESCRIPTION:	Paper Adhsv Address Labels 1/2 x 1-3/4, 100 SHT
11			TOTAL:	2	CARTONS
12
13			ITEM #:	2		1,170	PACKS
14			VPC #:	505-S212-0105
15			DESCRIPTION:	Paper Adhsv Address Labels 1 x 2-5/8, 100 SHT
16			TOTAL:	117	CARTONS
17
18			ITEM #:	3		320	PACKS
19			VPC #:	505-S212-0106
20			DESCRIPTION:	Paper Adhsv Address Labels 1 x 4, 100 SHT
21			TOTAL:	32	CARTONS
22
23			ITEM #:	ST18060		150	PACKS
24			VPC #:	505-S212-0108
25			DESCRIPTION:	Shipping Paper Adhsv Labels 2 x 4, 100 SHT
26			TOTAL:	15	CARTONS
27
28			ITEM #:	ST18061		80	PACKS
29			VPC #:	505-S212-0109
30			DESCRIPTION:	Shipping Paper Adhsv Labels 3-1/3 x 4, 100 SHT
31			TOTAL:	8	CARTONS
32
33			ITEM #:	ST18062		500	PACKS
34			VPC #:	505-S212-0110
35			DESCRIPTION:	Shipping Paper Adhsv Labels 8-1/2 x 11, 100 SHT
36			TOTAL:	50	CARTONS
37
38			ITEM #:	ST18064		315	PACKS
39			VPC #:	505-S212-0112
40			DESCRIPTION:	Paper Adhsv Address Labels 1 x 4, 250 SHT
41			TOTAL:	63	CARTONS
42
43			ITEM #:	ST18066		60	PACKS
44			VPC #:	505-S212-0114
45			DESCRIPTION:	Shipping Paper Adhsv Labels 2 x 4, 250 SHT
46			TOTAL:	12	CARTONS
47
48			ITEM #:	ST18067		270	PACKS
49			VPC #:	505-S212-0115
50			DESCRIPTION:	Shipping Paper Adhsv Labels 3-1/3 x 4, 250 SHT
51			TOTAL:	54	CARTONS
52
53			ITEM #:	ST18074		50	PACKS
54			VPC #:	505-S212-0116
55			DESCRIPTION:	Shipping Paper Adhsv Labels 3-1/2 x 5, 100 SHT
56			TOTAL:	5	CARTONS
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73			* FREIGHT COLLECT
74			* NO WOOD PACKAGING MATERIALS WERE USED IN THIS SHIPMENT
75			* CONSIGNEE:	STAPLES BRANDS GROUP
76				A DIVISION OF STAPLES, THE OFFICE SUPERSTORE, LLC
77				500 STAPLES DRIVE
78				adafsa
79
80
Sheet2

 

[Peter_SSs]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Try this with a copy of your worksheet. It leaves one blank row between those two sections.

Sub Del_Rows()
  Dim rB As Range
 
  For Each rB In Range("C1", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlBlanks).Areas
    If rB.Rows.Count > 1 Then rB.Resize(rB.Rows.Count - 1).EntireRow.Delete
  Next rB
End Sub

 

[kvsrinivasamurthy]

Try on a copy of file.

Sub DeleteRows()
Dim Lr&, T&, S$
Dim M

Lr = Range("C" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If(LEN(C2:C" & Lr & "&D2:D" & Lr & "&E2:E" & Lr & "&F2:F" & Lr & "&G2:G" & Lr & ")=0,""C""&Row(C2:C" & Lr & "),false))"), False, False)
For T = UBound(M) To 0 Step -1
S = S & "," & M(T)
If Len(S) > 240 Or (T = 0 And Len(S) > 0) Then Range(Mid(S, 2)).EntireRow.Delete
Next T
End Sub

 

[Fuji]

I would like to seek your help deleting blank rows between 2 used ranges.
I expect to remove the blank rows between the last rows of the used range 1 ( row 56) and the first row of the used range 2 ( row 73).

try

Sub test()
    Dim LR&, x&, y&
    LR = Range("c" & Rows.Count).End(xlUp).Row
    x = Evaluate("max(if(c1:c" & LR & "=""TOTAL:"",row(1:" & LR & ")))")
    If x = 0 Then Exit Sub
    y = Evaluate("min(if(c" & x + 1 & ":c" & LR & "<>"""",row(" & x + 1 & ":" & LR & ")))")
    If (y <> 0) * (y - x > 1) Then Rows(x + 1 & ":" & y - 1).Delete
End Sub

 

[kvsrinivasamurthy]

This code will delete rows between ranges and does not delete single blank rows in the data.

Sub DeleteRows()
Dim Lr&, T&, S$
Dim M

Lr = Range("C" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If(LEN(C2:C" & Lr & "&D2:D" & Lr & "&E2:E" & Lr & "&F2:F" & Lr & "&G2:G" & Lr & ")=0,Row(C2:C" & Lr & "),false))"), False, False)
For T = UBound(M) To 1 Step -1
If Val(M(T - 1)) = Val(M(T)) - 1 Then S = S & ",C" & M(T)
If Len(S) > 240 Or (T <= 1 And Len(S) > 0) Then Range(Mid(S, 2)).EntireRow.Delete: S = ""
Next T
End Sub

 

[ngochien251088]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Try this with a copy of your worksheet. It leaves one blank row between those two sections.

Sub Del_Rows()
  Dim rB As Range
 
  For Each rB In Range("C1", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlBlanks).Areas
    If rB.Rows.Count > 1 Then rB.Resize(rB.Rows.Count - 1).EntireRow.Delete
  Next rB
End Sub

Thank you so much for your quick code. It runs well. I appreciate your time.

 

[ngochien251088]

This code will delete rows between ranges and does not delete single blank rows in the data.

Sub DeleteRows()
Dim Lr&, T&, S$
Dim M

Lr = Range("C" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If(LEN(C2:C" & Lr & "&D2:D" & Lr & "&E2:E" & Lr & "&F2:F" & Lr & "&G2:G" & Lr & ")=0,Row(C2:C" & Lr & "),false))"), False, False)
For T = UBound(M) To 1 Step -1
If Val(M(T - 1)) = Val(M(T)) - 1 Then S = S & ",C" & M(T)
If Len(S) > 240 Or (T <= 1 And Len(S) > 0) Then Range(Mid(S, 2)).EntireRow.Delete: S = ""
Next T
End Sub

Thank you so much for your coding. It also goes well with my sheet! I appreciate it.

 

[Peter_SSs]

Thank you so much for your quick code. It runs well. I appreciate your time.

You're welcome. Thanks for the follow-up.

.. but don't forget about your profile update.

 

[ngochien251088]

You're welcome. Thanks for the follow-up.

.. but don't forget about your profile update.

Thank you so much for your reminder. I have updated my profile. Have a nice weekend!

 

[Peter_SSs]

I have updated my profile.

Thanks for that.