add message & disable the code based on condition

[abdo meghari]

hi

I have this code splits column into multiple columns , but if the spaces among the items are differnt I mean it's not one space among the items it will show error subscript out of range .

so what I want if the space is not equal one space among the items should show message " there are differnt spaces should correct them " and highlighted the cells by red into column D which doesn't contain one space among the items and disabling the macro and doesn't split the column until correct the space for the items are exsted into cells for column D .
note: the macro wll split column into four columns based on containing the cells in column D contains four items.

Sub Sample()
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim tmpArray() As String

    '~~> This is the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        LastRow = .Range("D" & .Rows.Count).End(xlUp).Row

        For i = 2 To LastRow
            If InStr(1, .Range("D" & i).Value, " ") Then
                tmpArray = Split(.Range("D" & i).Value, " ")
                .Range("E" & i).Value = tmpArray(0)
                .Range("F" & i).Value = tmpArray(1)
                .Range("G" & i).Value = tmpArray(2)
                .Range("H" & i).Value = tmpArray(3)
              
                
            End If
        Next i
    End With
End Sub

Bridgestone SPLIT).xlsm
	D
1	MRGED
2	BS 1200R20 TCF G580 JAP
3	BS 1200R20 TC G580 THI
4	BS 1200R24 G582 JAP
5	BS 13R22.5 R187 JAP
6	BS 1400R20 T VSJ JAP
7	BS 155R12C R623 IND
8	BS 165R13C R624 IND
9	BS 175/70R13 EP150 IND
10	BS 175/70R14 EP150 THI
11	BS 1800R25 VKT** JAP
12	BS 185/65R14 EP150 IND
13	BS 185/65R14 TEC THI
14	BS 185/65R15 T005 IND
15	BS 185/65R15 T01 JAP
16	BS 185/70R13 EP150 IND
17	BS 195/60R15 EP150 THA
18	BS 195/65R15 EP15 JAP
19	BS 195/65R15 EP150 THI
20	BS 195/70R15C R623 JAP
21	BS 195R14C 613 JAP
22	BS 195R15C R623 THI
23	BS 205/60R16 T001 JAP
24	BS 205/65R15 EP150 IND
25	BS 205/70R15C R623 THI
26	BS 205R16C D840 THI
27	BS 215/50R17 EP300 THI
28	BS 215/55R16 EP300 IND
29	BS 215/55R17 AR20 IND
30	BS 215/55R17 GR90 IND
31	BS 215/55R17 MY-02 THI
32	BS 215/60R16 EP300 THI
33	BS 215/60R16 T005A THI
34	BS 215/70R15C R623 THI
35	BS 225/55R16 EP300 IND
36	BS 225/60R16 EP300 IND
37	BS 225/60R16 T001 JAP
38	BS 225/70R15C R623 JAP
39	BS 225/70R16 D687 JAP
40	BS 225/70R16 H005 THI
41	BS 225/70R17 D697 THI
42	BS 235/55R17 T005 THA
43	BS 235/55R17 ER300 JAP
44	BS 235/55R18 E031 JAP
45	BS 235/60R16 T01 JAP
46	BS 245/40ZR20 S001 JAP
47	BS 245/45R17 T05A JAP
48	BS 245/45R18 EP300 THI
49	BS 245/45R19 T005 JAP
50	BS 245/70R17 684A JAP
51	BS 245/75R17 693A JAP
52	BS 255/70R15C D840 THI
53	BS 265/50R20 DHPA JAP
54	BS 265/60R18 D840 JAP
55	BS 265/65R17 D840 JAP
56	BS 265/70R16 D840 THI
57	BS 265/70R18 D684 JAP
58	BS 275/40R18 S007 JAP
59	BS 275/40R20 Dsport JAP
60	BS 275/45R19 AL01 JAP
61	BS 275/55R17 Dsport JAP
62	BS 275/55R20 AL01 JAP
63	BS 275/65R18 AL01 JAP
64	BS 275/70R16 D694 JAP
65	BS 285/60R18 DHPS JAP
66	BS 285/65R17 R683 JAP
67	BS 315/80R22.5 R152 JAP
68	BS 315/80R22.5 R184 JAP
69	BS 315/80R22.5 R184 THI
70	BS 315/80R22.5-18PR G580 JAP
71	BS 315/80R22.5-18PR G582 THI
72	BS 325/95R24 G582 JAP
73	BS 385/65R22.5 R164 JAP
74	BS 385/65R22.5 R164 THA
75	BS 425/65R22.5 R164 JAP
76	BS 445/65R22.5 R164 JAP
77	BS 650R16 R230 JAP
78	BS 700R16 R230 JAP
79	BS 750R16 R230 JAP
80	BS 750R16 VSJ JAP
81	BS LT285/75R16 AT001 JAP
82	DT 315/80R22.5 T DS50 THI
83	DT 385/65R22.5 DT40 THI
84	FS 205/65R15 TZ700 JAP
85	FS 215/55R17 TZ700 JAP
ITEM

any suggestion expert to complete this code ?

 

[mumps]

I pasted the data you posted into an Excel sheet and ran the macro. It highlighted the appropriate cells in red and displayed the message "Please correct the different spaces in the colored cells." I don't know why the message isn't displaying for you.

 

[abdo meghari]

@mumps again my apologies ! I was implement the code at another sheet is not matched as in the code that's why I have some problems .
your code works very well. many thanks

 

[mumps]

You are very welcome.

 

[RobVos]

I pasted your data and ran the code:

Original:

After Code runs There are four total remaining cells that need correction (highlighted red) - they have more than four parts when split.
Without the Trim function, there would be ten to correct. I would also add another if statement checking for data in E and skipping code if present.

 

[abdo meghari]

@RobVos my apologies ! thank you to guide me how your code should work.
your code is very excellent ! thanks so much
have a nice weekend !

 

[RobVos]

On the second time running, it will run much faster if you add:

If .Range("E" & i) = "" Then
right after the
For i = 2 To lastRow
and put an End If right before the line
Next i

 

[abdo meghari]

@steve the fish Forgive me!

I have been busy with others on how to solve the problem. Although your code does not do what I want like other members, but I tried it and found it's very flexible as it divides the cell into several cells regardless of the content of the cell . It is really useful code.
thanks so much for your contribution