Delete first and last item for each cell in the same column for two sheets

abdo meghari

Well-known Member
Joined
Aug 3, 2021
Messages
651
Office Version
  1. 2019
Hi guys,
I would macro to delete the first and last item for each cell in column J for two sheets.
the first item always contains space after it and last item always contains space before it . also will contain many letters for first and last item.
CH.xlsm
IJKLMN
1CODEBRANDUNIT PRICE1UNIT PRICE2UNIT PRICE3UNIT PRICE4
21241BS 1200R20 G580 JAP2035000
31244BS 1200R20 R187 JAP2000000
41269BS 1200R24 G580 JAP1900000
51556BS 185R14C R660 TR423000
61221BS 205/70R15C R623 THI405000
71547BS 205R16C D840 THI625000
81502BS 215/65R16C R611 THI60058300
91227BS 215/70R15C R623 THI42554400
101503BS 225/85R16C R202 JAP975000
111310BS 225/95R16C D618 JAP515695715700
121402BS 245/70R16 D697 JAP590000
131346DUN 255/70R15C D840 JAPAN50563500
141326BS 265/60R18 D840 JAP721000
151534BS 265/65R17 D693 THAILAND745000
161391BS 265/65R17 D840 JAP53569000
171411MARS 275/55R20 ALENZA1 KORIA72594200
181190BS 285/50R20 DSPORT JAP93670500
191315BS 315/80R22.5 G580 JAP 2470000
201257BS 315/80R22.5 R184 JAP2015000
211401BS 650R16 R230 JAP570000
221305HILO 700R16 R230 JAP762000
231306BS 750R16 R230 JAP71594000
241307BS 750R16 VSJ JAP910000
251284GC 1200R20 AZ0026 CHINA895112500
261285GC 1200R20 AZ0183 CHI925122512050
271292GC 1200R24 AZ166 CHI935000
281385GC 315/80R22.5 AT161 CHI73595500
291287GC 315/80R22.5 AZ126 CHI735000
301294GC 315/80R22.5 AZ188 CHI74596500
311492GC 385/65R22.5 AT131 CHI1275000
321528TH 185/65R14 H-93 CHI134000
331493WL 195/65R15 Z-108 CHI173000
341486WL 205/55R16 Z-108 CHI185000
PURCHASING


CH.xlsm
IJKLM
1CODEBRANDQTYUNIT PRICETOTAL
21306BS 750R16 R230 JAP107757750
31306BS 750R16 R230 JAP47803120
41305BS 700R16 R230 JAP27701540
SELLING
Cell Formulas
RangeFormula
M2:M4M2=K2*L2




Result
CH.xlsm
IJKLMN
1CODEBRANDUNIT PRICE1UNIT PRICE2UNIT PRICE3UNIT PRICE4
212411200R20 G5802035000
312441200R20 R1872000000
412691200R24 G5801900000
51556185R14C R660423000
61221205/70R15C R623405000
71547205R16C D840625000
81502215/65R16C R61160058300
91227215/70R15C R62342554400
101503225/85R16C R202975000
111310225/95R16C D618515695715700
121402245/70R16 D697590000
131346255/70R15C D84050563500
141326265/60R18 D840721000
151534265/65R17 D693745000
161391265/65R17 D84053569000
171411275/55R20 ALENZA172594200
181190285/50R20 DSPORT93670500
191315315/80R22.5 G5802470000
201257315/80R22.5 R1842015000
211401650R16 R230570000
221305700R16 R230762000
231306750R16 R23071594000
241307750R16 VSJ910000
2512841200R20 AZ0026895112500
2612851200R20 AZ0183925122512050
2712921200R24 AZ166935000
281385315/80R22.5 AT16173595500
291287315/80R22.5 AZ126735000
301294315/80R22.5 AZ18874596500
311492385/65R22.5 AT1311275000
321528185/65R14 H-93134000
331493195/65R15 Z-108173000
341486205/55R16 Z-108185000
PURCHASING


the same thing for second sheet
thanks
 
OMG Peter!
the code is fantastic !
I tested
1- it won't update for brand is already deleted items.
2-it updates for new brand if I want to add without repeat deleting for brand is already deleted items.
3- it's not just contains 4 parts I see to deal with 5,6,7.. parts.
just last thin may you change this line
VBA Code:
 For Each Sh In aSheets
by using two specific sheets,please?
thank you so much.:)
 
Last edited:
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
VBA Code:
 For Each Sh In aSheets
by using two specific sheets,please?
thank you so much.:)
The line For Each Sh In aSheets
Needs to be read in the context of aSheets = Split("PURCHASING|SELLING", "|")
It will only update the sheets named in this pipe delimited list and that is currently only the "two specific sheets" you have mentioned.
 
Upvote 0
thank you so much guys.
You're welcome. Glad it worked for you. :)

I did post that code in a bit of a rush and it has a couple of things in it that are not actually needed (but will not do any harm) as they were just there for me when testing the code. The cleaned up code would be:

VBA Code:
Sub Fix_Brand()
  Dim RX As Object
  Dim a As Variant, aSheets As Variant, Sh As Variant
  Dim i As Long
  
  aSheets = Split("PURCHASING|SELLING", "|")
  Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = "(^[^0-9]+ )(.*?)( [^ ]+ ?$)"
  For Each Sh In aSheets
    With Sheets(Sh)
      With .Range("J2", .Range("J" & Rows.Count).End(xlUp))
        a = .Value
        For i = 1 To UBound(a)
          a(i, 1) = RX.Replace(a(i, 1), "$2")
        Next i
        .Value = a
      End With
    End With
  Next Sh
End Sub
 
Upvote 0
Solution
Hi,Peter again
Can you modify code by deletion the whole items except the second item, please?
every cell contains three or four or five six items ....,then just keep the second item like this
DELITEM
J
1BRAND
21200R20
31200R20
41200R24
5185R14C
6205/70R15C
7205R16C
8215/65R16C
9215/70R15C
10225/85R16C
11225/95R16C
12245/70R16
13255/70R15C
14265/60R18
15265/65R17
16265/65R17
17275/55R20
18285/50R20
19315/80R22.5
20315/80R22.5
21650R16
22700R16
23750R16
24750R16
251200R20
261200R20
271200R24
28315/80R22.5
29315/80R22.5
30315/80R22.5
31385/65R22.5
32185/65R14
33195/65R15
34205/55R16
PURCHASING
 
Upvote 0
Try this version.

VBA Code:
Sub Second_Brand_Only()
  Dim aSheets As Variant, Sh As Variant
  
  aSheets = Split("PURCHASING|SELLING", "|")
  For Each Sh In aSheets
    With Sheets(Sh).Range("J2", Sheets(Sh).Range("J" & Rows.Count).End(xlUp))
      .TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=True, Other:=False, _
        FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 9), Array(4, 9), Array(5, 9), Array(6, 9), Array(7, 9), Array(8, 9))
    End With
  Next Sh
End Sub
 
Upvote 0
Another option to try would be
VBA Code:
Sub Second_Brand_Only_v2()
  Dim aSheets As Variant, Sh As Variant
  
  aSheets = Split("PURCHASING|SELLING", "|")
  For Each Sh In aSheets
    With Sheets(Sh).Range("J2", Sheets(Sh).Range("J" & Rows.Count).End(xlUp))
      .Value = Evaluate("trim(mid(substitute(trim(" & .Address(External:=True) & "),"" "",REPT("" "",100)),100,100))")
    End With
  Next Sh
End Sub
 
Upvote 0
Awesome !
can you fix error in this line
VBA Code:
.TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=True, Other:=False, _
        FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 9), Array(4, 9), Array(5, 9), Array(6, 9), Array(7, 9), Array(8, 9))
when run the macro if there is no items except one item after running from the first time like pop msg
"there are no items to delete them" and exit sub.
 
Upvote 0
Try

VBA Code:
Sub Second_Brand_Only_v3()
  Dim aSheets As Variant, Sh As Variant
  
  aSheets = Split("PURCHASING|SELLING", "|")
  For Each Sh In aSheets
    With Sheets(Sh).Range("J2", Sheets(Sh).Range("J" & Rows.Count).End(xlUp))
      .Value = Evaluate(Replace("if(isnumber(find("" "",trim(#))),trim(mid(substitute(trim(#),"" "",REPT("" "",100)),100,100)),#)", "#", .Address(External:=True)))
    End With
  Next Sh
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,173
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top