VBA question for text from isometric drawings

oguztuna · Jan 9, 2016

[h=2]VBA for edit text and remove blank rows[/h]

I m finding out <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help;">VBA</acronym> for merging text with a space from below cells which has blank at the next column , and then remove the row that has blanks, as shown below. How can I solve this problem?

First Form

1	1.500WT - PIPE SSAWL API 5L BE	30	PPXC209620	7.0M
	API-5L-X65M PSL-2 LTD
2	SCH80 - PIPE SSAWL API 5L BE API-5L-X65M	24	PPXC209619	1.2M
	PSL-2 LTD
3	SCH80 - PIPE SSAWL API 5L BE API-5L-X65M	18	PPXC209617	2.3M
	PSL-2 LTD
4	1.500WT - ELL 90 LR WLD MSSSP-75 (PSO)	30	PCHB11545	1
	BE A860 MSS SP75-WPHY-65
5	1.500WT - FLG WN MSS-SP-44 BE/RF CL 900	30	PFWA265709	1
	A707-L5 CL4

After Edit

1	1.500WT - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD	30	PPXC209620	7.0M
2	SCH80 - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD	24	PPXC209619	1.2M
3	SCH80 - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD	18	PPXC209617	2.3M
4	1.500WT - ELL 90 LR WLD MSSSP-75 (PSO) BE A860 MSS SP75-WPHY-65	30	PCHB11545	1
5	1.500WT - FLG WN MSS-SP-44 BE/RF CL 900 A707-L5 CL4	30	PFWA265709	1

Many Thanks,

Tuna

Peter_SSs · Jan 9, 2016

Welcome to the MrExcel board!

Try this in a copy of your workbook.

Original data was in A1:G10.
Macro has produced the data in A14:G18.

Excel Workbook

A

B

C

D

E

F

G

1

1.500WT - PIPE SSAWL API 5L BE

30

PPXC209620

7.0M

2

API-5L-X65M PSL-2 LTD

3

2

SCH80 - PIPE SSAWL API 5L BE API-5L-X65M

24

PPXC209619

1.2M

4

PSL-2 LTD

5

3

SCH80 - PIPE SSAWL API 5L BE API-5L-X65M

18

PPXC209617

2.3M

6

PSL-2 LTD

7

4

1.500WT - ELL 90 LR WLD MSSSP-75 (PSO)

30

PCHB11545

1

8

BE A860 MSS SP75-WPHY-65

9

5

1.500WT - FLG WN MSS-SP-44 BE/RF CL 900

30

PFWA265709

1

10

A707-L5 CL4

11

12

13

14

1

1.500WT - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD

30

PPXC209620

7.0M

15

2

SCH80 - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD

24

PPXC209619

1.2M

16

3

SCH80 - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD

18

PPXC209617

2.3M

17

4

1.500WT - ELL 90 LR WLD MSSSP-75 (PSO) BE A860 MSS SP75-WPHY-65

30

PCHB11545

1

18

5

1.500WT - FLG WN MSS-SP-44 BE/RF CL 900 A707-L5 CL4

30

PFWA265709

1

19

Rearrange

Rich (BB code):

Sub Rearrange()
  Dim a, b
  Dim i As Long, j As Long, k As Long
  
  With Range("A1:G" & Range("C" & Rows.Count).End(xlUp).Row)
    a = .Value
    ReDim b(1 To UBound(a) / 2, 1 To 7)
    For i = 1 To UBound(a) Step 2
      k = k + 1
      For j = 1 To 7
        b(k, j) = a(i, j)
      Next j
      b(k, 3) = b(k, 3) & " " & a(i + 1, 3)
    Next i
    .Offset(.Rows.Count + 3).Resize(k).Value = b
  End With
End Sub

oguztuna · Jan 9, 2016

Hi, thanks for this sharing, I d like to know that how this formula works for over 1000 cells and count of blank row is sometimes 3 and sometimes 2 that was given in previous example.

Peter_SSs · Jan 10, 2016

oguztuna said:
... count of blank row is sometimes 3 and sometimes 2 that was given in previous example.

If that means that your previous sample data was not representative of your actual data, then please give another small sample that is representative and also give the expected results again.

oguztuna · Jan 10, 2016

Hi,sample that I mentioned is given below.

First Form

			SHOP MATERIAL
PT		DESCRIPTION		NB	SPM IDENT	QTY
No.				(IN)	CODE
1		1.500WT - PIPE SSAWL API 5L BE		30	PPXC209620	7.0M
		API-5L-X65M PSL-2 LTD
2		SCH80 - PIPE SSAWL API 5L BE API-5L-X65M		24	PPXC209619	1.2M
		PSL-2 LTD
3		SCH80 - PIPE SSAWL API 5L BE API-5L-X65M		18	PPXC209617	2.3M
		PSL-2 LTD
4		1.500WT - ELL 90 LR WLD MSSSP-75 (PSO)		30	PCHB11545	1
		BE A860 MSS SP75-WPHY-65
5		1.500WT - FLG WN MSS-SP-44 BE/RF CL 900		30	PFWA265709	1
		A707-L5 CL4
	PIPE SUPPORTS
6		- Base Support 30-24-BS01-1		24	TT04.600	1
7		Trunnion Bearing Plate for Acoustic Pad		24	GT649-600	1
		24-TG01-E-225 .
8		Trunnion Bearing Plate for Acoustic Pad		24	GT649-600	1
		24-TG01-E-130 .
9		- Trunnion on Straight Pipe		18	TT17.18	2
		30-18-WA06-1150-1
10		Welded Pipe Shoe for LTCS Pipe (-46C to		18	AT502-450	2
		+150C) 18-SH04-100-550 .
11		Shoe Gusset Plates (Double)		18	GT510-450	2
		SG02-329-330-12-170-LTCS Low Temperature
		Carbon Steel
			ERECTION MATERIALS
PT		DESCRIPTION		NB	SPM IDENT	QTY
No.				(IN)	CODE
	PIPE SUPPORTS
12		Acoustic Isolation Pad Without Backing		24	AT533-600	2
		Plate (Uninsulated Pipe) 24-IS06-200-230
		.
13		Acoustic Isolation Pad Without Backing		24	AT533-600	2
		Plate (Uninsulated Pipe) 24-IS06-100-230
14		Special Support		24	SPECIAL.24	1
15		Pedestal Guide (Heavy Load)		24	GT665-600	1
		24-BG06-250-255-20-2-3-10 .
16		Pedestal Guide (Heavy Load)		24	GT665-600	1
		24-BG06-160-255-20-2-2-6 .
17		Acoustic Isolation Pad (Type E) with		18	AT40E-18	2
		Backing Plate 18-IS07-E-200-200 .
18		Shoe Line Stop (Heavy Load)		18	ST505-450	2
		18-LS03-210-250-20-2-3-150-6 .
19		Special Support		18	SPECIAL.18	1
20		Acoustic Isolation Pad Without Backing		18	AT548-450	2
		Plate (Uninsulated Pipe Stop)
		18-IS06-160-200 .

Expected Result

	SHOP MATERIAL
PT	DESCRIPTION	NB	SPM IDENT	QTY
No.		(IN)	CODE
1	1.500WT - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD	30	PPXC209620	7.0M
2	SCH80 - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD	24	PPXC209619	1.2M
3	SCH80 - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD	18	PPXC209617	2.3M
4	1.500WT - ELL 90 LR WLD MSSSP-75 (PSO) BE A860 MSS SP75-WPHY-65	30	PCHB11545	1
5	1.500WT - FLG WN MSS-SP-44 BE/RF CL 900 A707-L5 CL4	30	PFWA265709	1
	PIPE SUPPORTS
6	- Base Support 30-24-BS01-1	24	TT04.600	1
7	Trunnion Bearing Plate for Acoustic Pad 24-TG01-E-225 .	24	GT649-600	1
8	Trunnion Bearing Plate for Acoustic Pad 24-TG01-E-130 .	24	GT649-600	1
9	- Trunnion on Straight Pipe 30-18-WA06-1150-1	18	TT17.18	2
10	Welded Pipe Shoe for LTCS Pipe (-46C to +150C) 18-SH04-100-550 .	18	AT502-450	2
11	Shoe Gusset Plates (Double) SG02-329-330-12-170-LTCS Low Temperature Carbon Steel	18	GT510-450	2
	ERECTION MATERIALS
PT	DESCRIPTION	NB	SPM IDENT	QTY
No.		(IN)	CODE
	PIPE SUPPORTS
12	Acoustic Isolation Pad Without Backing Plate (Uninsulated Pipe) 24-IS06-200-230 .	24	AT533-600	2
13	Acoustic Isolation Pad Without Backing Plate (Uninsulated Pipe) 24-IS06-100-230	24	AT533-600	2
14	Special Support	24	SPECIAL.24	1
15	Pedestal Guide (Heavy Load) 24-BG06-250-255-20-2-3-10 .	24	GT665-600	1
16	Pedestal Guide (Heavy Load) 24-BG06-160-255-20-2-2-6 .	24	GT665-600	1
17	Acoustic Isolation Pad (Type E) with Backing Plate 18-IS07-E-200-200 .	18	AT40E-18	2
18	Shoe Line Stop (Heavy Load) 18-LS03-210-250-20-2-3-150-6 .	18	ST505-450	2
19	Special Support	18	SPECIAL.18	1
20	Acoustic Isolation Pad Without Backing Plate (Uninsulated Pipe Stop) 18-IS06-160-200 .	18	AT548-450	2

Many Thanks

Peter_SSs · Jan 10, 2016

Without the borders like you posted in post #1, it's hard to tell what is in what column.

For the original data ..

1. What column is 'SHOP MARERIAL' in?

2. What column is 'DESCRIPTION' in?

3. What column is the heading 'NB' in?

4. Is 'SPM IDENT' in a single cell? Which cell?

5. Some data rows (eg 6 - Base Support...) only have one row. So what logic should we use to decide that 'A707-L5 CL4' is not a stand-alone line like 'PIPE SUPPORTS'?

6. What logic should we use to decide that 'PIPE SUPPORTS' - the first one - (being the second row in that area without an entry in the first column) goes on a line by itself in the results, but 'Carbon Steel' (also being the second row in that area without an entry in the first column) does NOT go on a line by itself but gets combined with the rows above?

oguztuna · Jan 10, 2016

Hi,

I specified the columns and rows at below,

The logic is ;

if it s just one data row, I wanna keep it same ,

if it s two data row and next column has one number and one blank cell under this cell , I wanna merge the data rows in one cell which has the number at next column cell.

if it s tree data row, the logic is same as 2 data row. I wanna delete 2 blank row and merge the 3 data rows in one cell.

Basically, I wanna keep the PT. No column numbers and delete blank cells at this column, and I wanna merge the datas which has the blank at next column as given below expected value.

First form

	A	B	C	D	E	F	G
1				SHOP MATERIAL
2	PT		DESCRIPTION		NB	SPM IDENT	QTY
3	No.				(IN)	CODE
4	1		1.500WT - PIPE SSAWL API 5L BE		30	PPXC209620	7.0M
5			API-5L-X65M PSL-2 LTD
6	2		SCH80 - PIPE SSAWL API 5L BE API-5L-X65M		24	PPXC209619	1.2M
7			PSL-2 LTD
8	3		SCH80 - PIPE SSAWL API 5L BE API-5L-X65M		18	PPXC209617	2.3M
9			PSL-2 LTD
10	4		1.500WT - ELL 90 LR WLD MSSSP-75 (PSO)		30	PCHB11545	1
11			BE A860 MSS SP75-WPHY-65
12	5		1.500WT - FLG WN MSS-SP-44 BE/RF CL 900		30	PFWA265709	1
13			A707-L5 CL4
14		PIPE SUPPORTS
15	6		- Base Support 30-24-BS01-1		24	TT04.600	1
16	7		Trunnion Bearing Plate for Acoustic Pad		24	GT649-600	1
17			24-TG01-E-225 .
18	8		Trunnion Bearing Plate for Acoustic Pad		24	GT649-600	1
19			24-TG01-E-130 .
20	9		- Trunnion on Straight Pipe		18	TT17.18	2
21			30-18-WA06-1150-1
22	10		Welded Pipe Shoe for LTCS Pipe (-46C to		18	AT502-450	2
23			+150C) 18-SH04-100-550 .
24	11		Shoe Gusset Plates (Double)		18	GT510-450	2
25			SG02-329-330-12-170-LTCS Low Temperature
26			Carbon Steel
27				ERECTION MATERIALS
28	PT		DESCRIPTION		NB	SPM IDENT	QTY
29	No.				(IN)	CODE
30		PIPE SUPPORTS
31	12		Acoustic Isolation Pad Without Backing		24	AT533-600	2
32			Plate (Uninsulated Pipe) 24-IS06-200-230
33			.
34	13		Acoustic Isolation Pad Without Backing		24	AT533-600	2
35			Plate (Uninsulated Pipe) 24-IS06-100-230
36	14		Special Support		24	SPECIAL.24	1
37	15		Pedestal Guide (Heavy Load)		24	GT665-600	1
38			24-BG06-250-255-20-2-3-10 .
39	16		Pedestal Guide (Heavy Load)		24	GT665-600	1
40			24-BG06-160-255-20-2-2-6 .
41	17		Acoustic Isolation Pad (Type E) with		18	AT40E-18	2
42			Backing Plate 18-IS07-E-200-200 .
43	18		Shoe Line Stop (Heavy Load)		18	ST505-450	2
44			18-LS03-210-250-20-2-3-150-6 .
45	19		Special Support		18	SPECIAL.18	1
46	20		Acoustic Isolation Pad Without Backing		18	AT548-450	2
47			Plate (Uninsulated Pipe Stop)
48			18-IS06-160-200 .

Expected Value

	A	B	C	D	E	F	G
1				SHOP MATERIAL
2	PT		DESCRIPTION		NB	SPM IDENT	QTY
3	No.				(IN)	CODE
4	1		1.500WT - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD		30	PPXC209620	7.0M
6	2		SCH80 - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD		24	PPXC209619	1.2M
8	3		SCH80 - PIPE SSAWL API 5L BE API-5L-X65M PSL-2 LTD		18	PPXC209617	2.3M
10	4		1.500WT - ELL 90 LR WLD MSSSP-75 (PSO) BE A860 MSS SP75-WPHY-65		30	PCHB11545	1
12	5		1.500WT - FLG WN MSS-SP-44 BE/RF CL 900 A707-L5 CL4		30	PFWA265709	1
14		PIPE SUPPORTS
15	6		- Base Support 30-24-BS01-1		24	TT04.600	1
16	7		Trunnion Bearing Plate for Acoustic Pad 24-TG01-E-225 .		24	GT649-600	1
18	8		Trunnion Bearing Plate for Acoustic Pad 24-TG01-E-130 .		24	GT649-600	1
20	9		- Trunnion on Straight Pipe 30-18-WA06-1150-1		18	TT17.18	2
22	10		Welded Pipe Shoe for LTCS Pipe (-46C to +150C) 18-SH04-100-550 .		18	AT502-450	2
24	11		Shoe Gusset Plates (Double) SG02-329-330-12-170-LTCS Low Temperature Carbon Steel		18	GT510-450	2
27				ERECTION MATERIALS
28	PT		DESCRIPTION		NB	SPM IDENT	QTY
29	No.				(IN)	CODE
30		PIPE SUPPORTS
31	12		Acoustic Isolation Pad Without Backing Plate (Uninsulated Pipe) 24-IS06-200-230 .		24	AT533-600	2
34	13		Acoustic Isolation Pad Without Backing Plate (Uninsulated Pipe) 24-IS06-100-230		24	AT533-600	2
36	14		Special Support		24	SPECIAL.24	1
37	15		Pedestal Guide (Heavy Load) 24-BG06-250-255-20-2-3-10 .		24	GT665-600	1
39	16		Pedestal Guide (Heavy Load) 24-BG06-160-255-20-2-2-6 .		24	GT665-600	1
41	17		Acoustic Isolation Pad (Type E) with Backing Plate 18-IS07-E-200-200 .		18	AT40E-18	2
43	18		Shoe Line Stop (Heavy Load) 18-LS03-210-250-20-2-3-150-6 .		18	ST505-450	2
45	19		Special Support		18	SPECIAL.18	1
46	20		Acoustic Isolation Pad Without Backing Plate (Uninsulated Pipe Stop) 18-IS06-160-200 .		18	AT548-450	2

Peter_SSs · Jan 10, 2016

Try

Rich (BB code):

Sub Rearrange_v2()
  Dim a, b
  Dim i As Long, j As Long, k As Long
  
  With Range("A1:G" & Range("C" & Rows.Count).End(xlUp).Row)
    a = .Value
    ReDim b(1 To UBound(a), 1 To 7)
    For i = 1 To UBound(a)
      Select Case True
        Case a(i, 3) = "", a(i, 1) <> ""
          k = k + 1
          For j = 1 To 7
            b(k, j) = a(i, j)
          Next j
        Case Else
          b(k, 3) = b(k, 3) & " " & a(i, 3)
      End Select
    Next i
    .Offset(.Rows.Count + 3).Resize(k).Value = b
  End With
End Sub

oguztuna · Jan 10, 2016

Thanks , it worked perfect.

Peter_SSs · Jan 10, 2016

oguztuna said:
Thanks , it worked perfect.

Good news! Thanks for letting us know.

VBA question for text from isometric drawings

oguztuna

New Member

Excel Facts

Peter_SSs

MrExcel MVP, Moderator

oguztuna

New Member

Peter_SSs

MrExcel MVP, Moderator

oguztuna

New Member

Peter_SSs

MrExcel MVP, Moderator

oguztuna

New Member

Peter_SSs

MrExcel MVP, Moderator

oguztuna

New Member

Peter_SSs

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

VBA question for text from isometric drawings

New Member

Excel Facts

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock