macro to delete unwanted characters and give output on the same cel

hi ,

i have below data where i want to delete some unwanted characters and give output on the same cell replacing the text

Example

9 QR 730 H 08JUL 3 DFWDOH HK8 1810 1640 09JUL E QR/PV2ZPV

Output required

QR 730 08JUL DFWDOH 1810 1640 09JUL QR/PV2ZPV

pls help thx

What is the rule to delete characters?

i am trying to trim the unwanted character and try to get below desired result

Output required

QR 730 08JUL DFWDOH 1810 1640 09JUL QR/PV2ZPV

See the link below.

https://www.excelforum.com/excel-pro...-the-data.html

I just stop posting codes for asking one by one and might be endless...

thx for the update will keep that in mind next time

hi

i have updated details as per your requirement, kindly provide me a solution for my post #6

Thanks

To add to what Alan and Ali have posted, perhaps the following will help you understand why they are asking the questions they are asking...

Please Note
-------------------
One thing you must keep in mind when you ask a question in a forum... the people you are asking to help you know absolutely nothing about your data, absolutely nothing about how it is laid out in the workbook, absolutely nothing about what you want done with it and absolutely nothing about how whatever it is you want done is to be presented back to you as a result... you must be very specific about describing each of these areas, in detail, and you should not assume that we will be able to "figure it out" on our own. Remember, you are asking us for help... so help us to be able to help you by providing the information we need to do so, even if that information seems "obvious" to you (remember, it is only obvious to you because of your familiarity with your data).

yes HK1 and GK1 should be removed and their position will remain the same, i have attached my file in post #17 for the same with eg to help u work on it

After you read the questions Ali has asked above (in Message #18), please read what I wrote in Message #16 and then answer Ali's questions adding anything else you think might be useful.

HK and GK will associated with number 1 to 9 only, it will not increase for

eg it will in this range HK1 ,HK2, HK3, HK4,HK5, HK6,HK7,HK8 and HK9 but i will never exceed from 9 , same case will be in GK it will never exceed 9

1. Will they (the codes) always have a space either side of them?

yes the space will be same either side of them

2. Is it just HK and GK, or are there other prefixes?

only prefixes like HK and GK , and HL, only these will be there.

those are the only ones which will be there nothing more

yes thats accurate ,

i was unable to understand how to frame the question, but the way you have explained it ill try to explain in the same way for future references.

See if the macro below does what you want. Note that you have to set the StartRow and DataColumn variables for the cell where your data actually starts at and set the OutputCell variable to the address fro the first cell where output should start at (I highlighted the rows where these variables must be set at in red to help you find them easier).

Sub RemoveHKandGKandHLcodes()
  Dim R As Long, X As Long, StartRow As Long, DataColumn As String, OutputCell As String, DataArray As Variant, Words As Variant
  
  StartRow = 13
  DataColumn = "M"
  OutputCell = "A1"
  
  DataArray = Range(Cells(StartRow, DataColumn), Cells(Rows.Count, DataColumn).End(xlUp))
  For R = 1 To UBound(DataArray)
    If Len(DataArray(R, 1)) Then
      Words = Split(DataArray(R, 1))
      For X = 0 To UBound(Words)
        If Words(X) Like "H[KL]#" Or Words(X) Like "GK#" Then Words(X) = ""
      Next
      DataArray(R, 1) = Application.Trim(Join(Words))
    End If
  Next
  Range(OutputCell).Resize(UBound(DataArray)) = DataArray
End Sub

thx for the update, but i was looking to update the same in below code,

Sub test()
    Dim a, i As Long, m As Object, dep, des, txt As String
    With Range("a1", Range("a" & Rows.Count).End(xlUp))
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Global = True
            For i = 2 To UBound(a, 1)
                txt = a(i, 1)
                .Pattern = "[^\u0021-\u007F]+"
                txt = Application.Trim(.Replace(txt, " "))
                .Pattern = "^ *\d+ *(\d[A-Z]|[A-Z][A-Z\d]) *(\d+) *[A-Z] *(\d{1,2}[A-Z]{3}) *\d[\* ]([A-Z]{3})" & _
                       "([A-Z]{3}) *([A-Z]{2}\d+) *(\d{4} *\d{4} *\d{1,2}[A-Z]{3}) *[A-Z] *(.*)$"
                    If .test(txt) Then
                    Set m = .Execute(txt)(0).submatches
                    dep = Application.VLookup(m(3), Sheets("airport").Range("a:b"), 2, False)
                    des = Application.VLookup(m(4), Sheets("airport").Range("a:b"), 2, False)
                    If IsError(dep) Then dep = m(3)
                    If IsError(des) Then des = m(4)
                    a(i, 1) = Application.Trim(.Replace(txt, "$1 $2  $3 " & dep & " " & des & " $6 $7 $8 "))
                End If
            Next
        End With
        .Value = a
    End With
End Sub

I do not do Regular Expression... I gave you what I think is working code without using Regular Expressions. If you feel you must use Regular Expressions, then you will have to wait for someone who knows how to program with them.

thx for the help sir, ill wait for an update from Mr Jindon as above code was made by him.

Hi sparkerk5

..i want to delete some unwanted characters and give output on the same cell replacing the text

I've looked through this thread and it seems pretty simple to remove unwanted characters and leave the updated text in the same cell.
So, if your original text is in column A, this easy-to-understand macro will do what you have asked..

Sub clearUnwantedChars()        'v1a

On Error Resume Next            'ignore expected error if any unwanted chars not found
For i = 1 To 9                  'loop; e.g. for HK1, HK2,..,HK9 etc
[A:A].Replace What:="HK" & i & " ", Replacement:=""     'replace unwanted "HK1 ",.., "HK9 "
[A:A].Replace What:="HL" & i & " ", Replacement:=""     'replace unwanted "HL1 ",.., "HL9 "
[A:A].Replace What:="GK" & i & " ", Replacement:=""     'replace unwanted "GK1 ",.., "GK9 "
Next i

On Error GoTo 0                 'reset error trapping
[a1].Select                     'put cellpointer in tidy location when finished

End Sub

zeddy

Unless you upload a complete set of data that shows all the possible patterns and EXACT result that you want, I will not write a code.
It will be just wasting time.

hi jindon ,

the code which you had made earlier is fine an it give out the desired result which i want, howvever its is only missing out to erase the "HK1" part in that line.

I am attached the workbook so can have look at the

Sample data :

QGYSZI
BOMVS316E/2005NM/11JUL20
1.ALAM/MOHD MAHFOOZ MR
2 QR 729 K 19JUL 7*DOHDFW HK1 0750 1530 19JUL E QR/QGYSZI
3 QR7584 K 19JUL 7*DFWMOB HK1 2105 2246 19JUL E QR/QGYSZI


Output given by your code :

QGYSZI
BOMVS316E/2005NM/11JUL20
1.ALAM/MOHD MAHFOOZ MR
QR 729 19JUL Doha (DOH) Dallas (DFW) HK1 0750 1530 19JUL QR/QGYSZI
QR 7584 19JUL Dallas (DFW) Mobile (MOB) HK1 2105 2246 19JUL QR/QGYSZI


Actual Output required

QGYSZI
BOMVS316E/2005NM/11JUL20
1.ALAM/MOHD MAHFOOZ MR
QR 729 19JUL Doha (DOH) Dallas (DFW) 0750 1530 19JUL QR/QGYSZI
QR 7584 19JUL Dallas (DFW) Mobile (MOB) 2105 2246 19JUL QR/QGYSZI


Please find the code earlier made by you

Sub test()
    Dim a, i As Long, m As Object, dep, des, txt As String
    With Range("a1", Range("a" & Rows.Count).End(xlUp))
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Global = True
            For i = 2 To UBound(a, 1)
                txt = a(i, 1)
                .Pattern = "[^\u0021-\u007F]+"
                txt = Application.Trim(.Replace(txt, " "))
                .Pattern = "^ *\d+ *(\d[A-Z]|[A-Z][A-Z\d]) *(\d+) *[A-Z] *(\d{1,2}[A-Z]{3}) *\d[\* ]([A-Z]{3})" & _
                       "([A-Z]{3}) *([A-Z]{2}\d+) *(\d{4} *\d{4} *\d{1,2}[A-Z]{3}) *[A-Z] *(.*)$"
                    If .test(txt) Then
                    Set m = .Execute(txt)(0).submatches
                    dep = Application.VLookup(m(3), Sheets("airport").Range("a:b"), 2, False)
                    des = Application.VLookup(m(4), Sheets("airport").Range("a:b"), 2, False)
                    If IsError(dep) Then dep = m(3)
                    If IsError(des) Then des = m(4)
                    a(i, 1) = Application.Trim(.Replace(txt, "$1 $2  $3 " & dep & " " & des & " $6 $7 $8 "))
                End If
            Next
        End With
        .Value = a
    End With
End Sub

Hope this helps.

Thanks

Hi sparkerk5

So, you didn't like my simpler code then???

zeddy

Hi sparkerk5

Here's my file with your sample data.


zeddy

Hi sparkerk5

I can make it more complicated if you want.
But it's not rocket science.

zeddy

Change

                .Pattern = "^ *\d+ *(\d[A-Z]|[A-Z][A-Z\d]) *(\d+) *[A-Z] *(\d{1,2}[A-Z]{3}) *\d[\* ]([A-Z]{3})" & _
                       "([A-Z]{3}) *([A-Z]{2}\d+) *(\d{4} *\d{4} *\d{1,2}[A-Z]{3}) *[A-Z] *(.*)$"
                    If .test(txt) Then
                    Set m = .Execute(txt)(0).submatches
                    dep = Application.VLookup(m(3), Sheets("airport").Range("a:b"), 2, False)
                    des = Application.VLookup(m(4), Sheets("airport").Range("a:b"), 2, False)
                    If IsError(dep) Then dep = m(3)
                    If IsError(des) Then des = m(4)
                    a(i, 1) = Application.Trim(.Replace(txt, "$1 $2  $3 " & dep & " " & des & " $6 $7 $8 "))
                End If

to

                .Pattern = "^ *\d+ *(\d[A-Z]|[A-Z][A-Z\d]) *(\d+) *[A-Z] *(\d{1,2}[A-Z]{3}) *\d[\* ]([A-Z]{3})" & _
                       "([A-Z]{3}) *[GH]K\d *(\d{4} *\d{4} *\d{1,2}[A-Z]{3}) *[A-Z] *(.*)$"
                If .test(txt) Then
                    Set m = .Execute(txt)(0).submatches
                    dep = Application.VLookup(m(3), Sheets("airport").Range("a:b"), 2, False)
                    des = Application.VLookup(m(4), Sheets("airport").Range("a:b"), 2, False)
                    If IsError(dep) Then dep = m(3)
                    If IsError(des) Then des = m(4)
                    a(i, 1) = Application.Trim(.Replace(txt, "$1 $2  $3 " & dep & " " & des & " $5 $6 $7"))
                End If

This is the last.
Just upload a workbook with the data and EXACT result that you want without password protect vbe.

Why should I work with vbe protected workbook?

hi

jindon sorry for the same, kindly find the file attached i have removed the password protection

Thanks

change to

                    a(i, 1) = Application.Trim(.Replace(txt, "$1 $2  $3 " & dep & " " & des & " $6 $7"))

thx that worked fine.

Appreciate your help.