# put the item in last location for adjacent cell to next column based on words



## abdo meghari (Jan 5, 2023)

Hi
in column F contains items JAP,THI,INDO   if  these are  existed  should  n't  happen  any  thing  ,if  not  then  should  add into last  location  based on adjacent cell into column C . the JAPAN=JAP  and  THAILAND=THI, and INDONESIA=INDO  and CHINA= CHI, TURKEY=TR  , if  it  contains  N/A also  shoud add JAP . after  that  should  delete columns  C,E 
before
copy .xlsmABCDEFG6QTYORIGINMARKBRANDITEM71533JAPANBRIDGESTONEBS 1200 R20 18PR G580 18100THAILANDBRIDGESTONEBS 1200 R20 18PR  G580 29100JAPANBRIDGESTONEBS 1200R20-18PR R187 JAP310100N/ABRIDGESTONEBS 650R16 R2304111069JAPANBRIDGESTONEBS 750R16 R230 TCF JAP51230JAPANBRIDGESTONEBS 225/60R17 D-SPORT  JAP613100THAILANDBRIDGESTONEBS 195/65R15 EP150 THI71415JAPANBRIDGESTONEBS 285/60R18 DHPS JAP815100THAILANDBRIDGESTONEBS 255/70R15C D840 THI91664JAPANBRIDGESTONEBS 225/95R16C D619 JAP1017110JAPANBRIDGESTONEBS 265/65R17 D840 JAP1118100THAILANDBRIDGESTONEBS 205R16C D840 THI121940JAPANBRIDGESTONEBS 275/65R18 AL01 JAP132016JAPANBRIDGESTONEBS 275/55R20 ALENZA1 JAP1421100JAPANBRIDGESTONEBS 195/65R15 T001 91V TL152240JAPANBRIDGESTONEBS 265/60R18  D840 162334INDONESIABRIDGESTONEBS 1200R20-18PR R187 172435INDONESIABRIDGESTONEBS 1200R20-18PR R188 INDO18BRAND

after
copy.xlsmABC6ITEMBRANDQTY71BS 1200 R20 18PR G580 JAP153382BS 1200 R20 18PR  G580 THI10093BS 1200R20-18PR R187 JAP100104BS 650R16 R230 JAP100115BS 750R16 R230 TCF JAP1069126BS 225/60R17 D-SPORT  JAP30137BS 195/65R15 EP150 THI100148BS 285/60R18 DHPS JAP15159BS 255/70R15C D840 THI1001610BS 225/95R16C D619 JAP641711BS 265/65R17 D840 JAP1101812BS 205R16C D840 THI1001913BS 275/65R18 AL01 JAP402014BS 275/55R20 ALENZA1 JAP162115BS 195/65R15 T001 91V TL JAP1002216BS 265/60R18  D840 JAP402317BS 1200R20-18PR R187 INDO342418BS 1200R20-18PR R188 INDO35expected


----------



## Flashbond (Jan 5, 2023)

You may paste this to H7:

```
=IF(COUNT(SEARCH({"JAP"\"THI"\"INDO"\"CHI"\"TR"},RIGHT(F7,3)))=0,F7&" "&LOOKUP(B7,{"CHINA"\"INDONESIA"\"JAPAN"\"N/A"\"THAILAND"\"TURKEY"},{"CHI"\"INDO"\"JAP"\"JAP"\"THI"\"TR"}),"")
```
Wait a sec. Are you looking for VBA?


----------



## abdo meghari (Jan 5, 2023)

> Wait a sec. Are you looking for VBA?


yes should  be


----------



## Flashbond (Jan 5, 2023)

```
Sub myFunction()
  Dim lRow As Long
  Dim abbr() As Variant
  Dim valexist As Boolean
  abbr = Array(Split("JAP,THI,CHI,INDO,TR,JAP", ","), Split("JAPAN,THAILAND,CHINA,INDONESIA,TURKEY,N/A", ","))
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For r = 7 To lRow
    valueExist = False
    For i = 0 To UBound(abbr(0))
      If Right(Cells(r, 6).Value, 3) = abbr(0)(i) Then
        valueExist = True
        Exit For
      End If
    Next
    If Not valueExist Then
      For i = 0 To UBound(abbr(0))
        If abbr(1)(i) = Cells(r, 2).Value Then
          Cells(r, 6).Value = Cells(r, 6).Value & " " & abbr(0)(i)
          Exit For
        End If
      Next
    End If
  Next
  Range(Columns(2), Columns(5)).EntireColumn.Delete
  Columns("A").Cut
  Columns("C").Insert Shift:=xlToRight
  Columns("C").Cut
  Columns("A").Insert Shift:=xlToRight
End Sub
```


----------



## abdo meghari (Jan 5, 2023)

thanks   
seem  to  work  except and  surprisingly the  last  item in last  row  add INDO    for  over it  another INDO  has  already  existed  .
you  can  note  it .
ITM.xlsmABC6ITEMBRANDQTY71BS 1200 R20 18PR G580  JAP153382BS 1200 R20 18PR  G580  THI10093BS 1200R20-18PR R187 JAP100104BS 650R16 R230 JAP100115BS 750R16 R230 TCF JAP1069126BS 225/60R17 D-SPORT  JAP30137BS 195/65R15 EP150 THI100148BS 285/60R18 DHPS JAP15159BS 255/70R15C D840 THI1001610BS 225/95R16C D619 JAP641711BS 265/65R17 D840 JAP1101812BS 205R16C D840 THI1001913BS 275/65R18 AL01 JAP402014BS 275/55R20 ALENZA1 JAP162115BS 195/65R15 T001 91V TL JAP1002216BS 265/60R18  D840  JAP402317BS 1200R20-18PR R187  INDO342418BS 1200R20-18PR R188 INDO INDO35match


----------



## Flashbond (Jan 5, 2023)

I think this should fix:

```
Sub myFunction()
  Dim lRow As Long
  Dim abbr() As Variant
  Dim valexist As Boolean
  abbr = Array(Split("JAP,THI,CHI,INDO,TR,JAP", ","), Split("JAPAN,THAILAND,CHINA,INDONESIA,TURKEY,N/A", ","))
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For r = 7 To lRow
    valueExist = False
    For i = 0 To UBound(abbr(0))
      If Right(Cells(r, 6).Value, 3) = Right(abbr(0)(i), 3) Then
        valueExist = True
        Exit For
      End If
    Next
    If Not valueExist Then
      For i = 0 To UBound(abbr(0))
        If abbr(1)(i) = Cells(r, 2).Value Then
          Cells(r, 6).Value = Cells(r, 6).Value & " " & abbr(0)(i)
          Exit For
        End If
      Next
    End If
  Next
  Range(Columns(2), Columns(5)).EntireColumn.Delete
  Columns("A").Cut
  Columns("C").Insert Shift:=xlToRight
  Columns("C").Cut
  Columns("A").Insert Shift:=xlToRight
End Sub
```


----------



## abdo meghari (Jan 6, 2023)

thanks  but  happened  the  same  problem with  TURKEY . I  no  know  why!


----------



## Flashbond (Jan 6, 2023)

Yes, I see. Ok this should solve all the problems:

```
Sub myFunction()
  Dim lRow As Long
  Dim abbr() As Variant
  Dim valexist As Boolean
  abbr = Array(Split("JAP,THI,CHI,INDO,TR,JAP", ","), Split("JAPAN,THAILAND,CHINA,INDONESIA,TURKEY,N/A", ","))
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For r = 7 To lRow
    valueExist = False
    For i = 0 To UBound(abbr(0))
      If Right(Cells(r, 6).Value, Len(abbr(0)(i))) = abbr(0)(i) Then
        valueExist = True
        Exit For
      End If
    Next
    If Not valueExist Then
      For i = 0 To UBound(abbr(0))
        If abbr(1)(i) = Cells(r, 2).Value Then
          Cells(r, 6).Value = Cells(r, 6).Value & " " & abbr(0)(i)
          Exit For
        End If
      Next
    End If
  Next
  Range(Columns(2), Columns(5)).EntireColumn.Delete
  Columns("A").Cut
  Columns("C").Insert Shift:=xlToRight
  Columns("C").Cut
  Columns("A").Insert Shift:=xlToRight
End Sub
```


----------



## abdo meghari (Jan 6, 2023)

Excellent !
this  works perfectly.
just  question , how  can  I  implement  your  code  fro  multiple   sheets  at  once  instead  of  select  specific  sheet  when  run  the  macro ?
 I mean  loop  throught  sheets(DATA,SOURCE,OUTCOME)


----------



## Flashbond (Jan 6, 2023)

```
Sub myFunction()
  Dim lRow As Long
  Dim abbr() As Variant
  Dim valexist As Boolean
  Dim wsheets() As String
  ws = Split("DATA,SOURCE,OUTCOME", ",")
  abbr = Array(Split("JAP,THI,CHI,INDO,TR,JAP", ","), Split("JAPAN,THAILAND,CHINA,INDONESIA,TURKEY,N/A", ","))
  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  
  For Each ws In wsheets
    With Worksheets(ws)
    For r = 7 To lRow
      valueExist = False
      For i = 0 To UBound(abbr(0))
        If Right(.Cells(r, 6).Value, Len(abbr(0)(i))) = abbr(0)(i) Then
          valueExist = True
          Exit For
        End If
     Next
      If Not valueExist Then
        For i = 0 To UBound(abbr(0))
          If abbr(1)(i) = .Cells(r, 2).Value Then
            .Cells(r, 6).Value = .Cells(r, 6).Value & " " & abbr(0)(i)
            Exit For
          End If
        Next
      End If
    Next
    End With
  Next
  .Range(.Columns(2), .Columns(5)).EntireColumn.Delete
  .Columns("A").Cut
  .Columns("C").Insert Shift:=xlToRight
  .Columns("C").Cut
  .Columns("A").Insert Shift:=xlToRight
End Sub
```


----------



## abdo meghari (Jan 5, 2023)

Hi
in column F contains items JAP,THI,INDO   if  these are  existed  should  n't  happen  any  thing  ,if  not  then  should  add into last  location  based on adjacent cell into column C . the JAPAN=JAP  and  THAILAND=THI, and INDONESIA=INDO  and CHINA= CHI, TURKEY=TR  , if  it  contains  N/A also  shoud add JAP . after  that  should  delete columns  C,E 
before
copy .xlsmABCDEFG6QTYORIGINMARKBRANDITEM71533JAPANBRIDGESTONEBS 1200 R20 18PR G580 18100THAILANDBRIDGESTONEBS 1200 R20 18PR  G580 29100JAPANBRIDGESTONEBS 1200R20-18PR R187 JAP310100N/ABRIDGESTONEBS 650R16 R2304111069JAPANBRIDGESTONEBS 750R16 R230 TCF JAP51230JAPANBRIDGESTONEBS 225/60R17 D-SPORT  JAP613100THAILANDBRIDGESTONEBS 195/65R15 EP150 THI71415JAPANBRIDGESTONEBS 285/60R18 DHPS JAP815100THAILANDBRIDGESTONEBS 255/70R15C D840 THI91664JAPANBRIDGESTONEBS 225/95R16C D619 JAP1017110JAPANBRIDGESTONEBS 265/65R17 D840 JAP1118100THAILANDBRIDGESTONEBS 205R16C D840 THI121940JAPANBRIDGESTONEBS 275/65R18 AL01 JAP132016JAPANBRIDGESTONEBS 275/55R20 ALENZA1 JAP1421100JAPANBRIDGESTONEBS 195/65R15 T001 91V TL152240JAPANBRIDGESTONEBS 265/60R18  D840 162334INDONESIABRIDGESTONEBS 1200R20-18PR R187 172435INDONESIABRIDGESTONEBS 1200R20-18PR R188 INDO18BRAND

after
copy.xlsmABC6ITEMBRANDQTY71BS 1200 R20 18PR G580 JAP153382BS 1200 R20 18PR  G580 THI10093BS 1200R20-18PR R187 JAP100104BS 650R16 R230 JAP100115BS 750R16 R230 TCF JAP1069126BS 225/60R17 D-SPORT  JAP30137BS 195/65R15 EP150 THI100148BS 285/60R18 DHPS JAP15159BS 255/70R15C D840 THI1001610BS 225/95R16C D619 JAP641711BS 265/65R17 D840 JAP1101812BS 205R16C D840 THI1001913BS 275/65R18 AL01 JAP402014BS 275/55R20 ALENZA1 JAP162115BS 195/65R15 T001 91V TL JAP1002216BS 265/60R18  D840 JAP402317BS 1200R20-18PR R187 INDO342418BS 1200R20-18PR R188 INDO35expected


----------



## abdo meghari (Jan 6, 2023)

thanks  again 
gives error for loop not  initialized in this line

```
For Each ws In wsheets
```


----------



## Flashbond (Jan 6, 2023)

Change this line:

```
ws = Split("DATA,SOURCE,OUTCOME", ",")
```
to this:

```
wsheets = Split("DATA,SOURCE,OUTCOME", ",")
```


----------



## abdo meghari (Jan 6, 2023)

it  still implements  just  for  selected  sheet , not  all at  once .


----------



## Flashbond (Jan 6, 2023)

This should work

```
Sub myFunction()
  Dim lRow As Long
  Dim abbr() As Variant
  Dim valexist As Boolean
  Dim wsheets() As String
  wsheets = Split("DATA,SOURCE,OUTCOME", ",")
  abbr = Array(Split("JAP,THI,CHI,INDO,TR,JAP", ","), Split("JAPAN,THAILAND,CHINA,INDONESIA,TURKEY,N/A", ","))
  
  For Each ws In wsheets
    With Worksheets(ws)
    lRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For r = 7 To lRow
      valueExist = False
      For i = 0 To UBound(abbr(0))
        If Right(.Cells(r, 6).Value, Len(abbr(0)(i))) = abbr(0)(i) Then
          valueExist = True
          Exit For
        End If
     Next
      If Not valueExist Then
        For i = 0 To UBound(abbr(0))
          If abbr(1)(i) = .Cells(r, 2).Value Then
            .Cells(r, 6).Value = .Cells(r, 6).Value & " " & abbr(0)(i)
            Exit For
          End If
        Next
      End If
    Next
    .Range(.Columns(2), .Columns(5)).EntireColumn.Delete
    .Columns("A").Cut
    .Columns("C").Insert Shift:=xlToRight
    .Columns("C").Cut
    .Columns("A").Insert Shift:=xlToRight
    End With
  Next
End Sub
```


----------



## abdo meghari (Jan 6, 2023)

seem  there  is  compile error for  the  last  word NEXT 
NEXT without for


----------



## Flashbond (Jan 6, 2023)

Copy and try again. I edited the code. If doesn't work, I have no other solution.


----------



## abdo meghari (Jan 6, 2023)

all of  things  are  ok now 
thanks  very  much  for  dedicating your  time  to  help  me .


----------



## Flashbond (Jan 6, 2023)

No worries. Gald it did work finally


----------

