Line spitting with specific characteristics

[manosalexo]

Hello there.

I have a situation.
Every once a month i have to deal with some addresses.
I have managed so far to remove some useless information like this

[TABLE="width: 473"]
<colgroup><col></colgroup><tbody>[TR]
[TD]ΗΡΑΚΛΕΙΔΩΝ 36 ΑΘΗΝΑ 11851 ΑΤΤΙΚΗΣ[/TD]
[/TR]
[TR]
[TD]ΗΡΩΩΝ ΠΟΛΥΤΕΧΝΕΙΟΥ 23 ΑΓ.ΣΤΕΦΑΝΟΣ 14565 ΑΤΤΙΚΗΣ[/TD]
[/TR]
[TR]
[TD]ΠΥΡΓΙΩΤΙΣΣΗΣ 29 ΠΕΡΙΣΤΕΡΙ 12136 ΑΤΤΙΚΗΣ[/TD]
[/TR]
[TR]
[TD]ΤΡΥΠΙΑ 26 Β ΠΕΥΚΗ 15121 ΑΤΤΙΚΗΣ[/TD]
[/TR]
[TR]
[TD]EYΓENΩN 5 - ΠEPIΣTEPI 12134

Result:

[TABLE="width: 340"]
<colgroup><col></colgroup><tbody>[TR]
[TD]ΗΡΑΚΛΕΙΔΩΝ 36 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΗΡΩΩΝ ΠΟΛΥΤΕΧΝΕΙΟΥ 23 ΑΓ.ΣΤΕΦΑΝΟΣ[/TD]
[/TR]
[TR]
[TD]ΠΥΡΓΙΩΤΙΣΣΗΣ 29 ΠΕΡΙΣΤΕΡΙ[/TD]
[/TR]
[TR]
[TD]ΤΡΥΠΙΑ 26 Β ΠΕΥΚΗ[/TD]
[/TR]
[TR]
[TD]EYΓENΩN 5 ΠEPIΣTEPI

Now i want to line split to the next column anything that is right of the number value.

I have been using this line of code:

[/TD]
[/TR]
</tbody>[/TABLE]

[/TD]
[/TR]
</tbody>[/TABLE]

Dim allCombi As String
    Dim allArrCombi(), allAftCombi()  As String
    
    
    
    sourceADR = Worksheets("CASE").Range("N" & i).Value
    
     Worksheets("MAIN_CONTROL").Cells(i, 25).Value = sourceADR
    
    sourceADR = Replace(sourceADR, "ÁÔÔÉÊÇÓ", "")
    


    
    '...................................................................
     sourceADR = Replace(sourceADR, "-", " ")
     sourceADR = Replace(sourceADR, "  ", " ")
     sourceADR = Trim(sourceADR)
     
    
     auxC = sourceADR
     
     
Worksheets("MAIN_CONTROL").Cells(i, 26).Value = sourceADR
 '..............................
     If (Len(sourceADR) < 1) Then GoTo aseAddr
 '..............
    mainAddress = Split(sourceADR)
     
     addrAA = ""
   Worksheets("MAIN_CONTROL").Cells(i, 24).Value = Str(UBound(mainAddress)) & "@@" & Str(LBound(mainAddress))
     
     
     For jA = UBound(mainAddress) To LBound(mainAddress) Step -1
     
    
    '......................................................
    
    
   If (regex.Test(Trim(mainAddress(jA)))) Then
   
   
   auxC = Replace(auxC, Trim(mainAddress(jA)), "")
    destws.Range("BT" & i).Value = Trim(mainAddress(jA))
    destws.Range("AA" & i).Value = Trim(mainAddress(jA))
    'destws.Range("Z" & i).Value = addrAA


   auxC = Trim(auxC)
    destws.Range("Y" & i).Value = auxC
    destws.Range("Z" & i).Value = addrAA
  '--------------------------------------------------------
   
'-------------------------------------------------------
   
   GoTo aseAddr
   
   
    End If
 
  


   
   auxC = Replace(auxC, Trim(mainAddress(jA)), "")
   addrAA = mainAddress(jA) & " " & addrAA
   
   
   
   
        
          
       
    
  '
    
    '.....................................................
    Next jA

Could anyone please help me?
Thanks in advance

 

[DanteAmor]

The code is not complete, you could better explain what you have and what you expect of result.

 

[manosalexo]

The code is not complete, you could better explain what you have and what you expect of result.

Ok so, i have a column with addresses like
Kountouri 35 Athens
Ag.ioannou 55 kallithea
Patriarxou makariou 6A Agios Dimitrios
Karaoli dimitriou 112 Agios Antonios.

What i want to do is to split to the next column anything after the number value.

Note that some number values may have a single letter string even with a space between. This single letter must be in the same column with the number value

 

[DanteAmor]

Try the following, your data in column N of row 2 down, the results will be in columns Y and Z

Sub Extract_Text()
    Dim sh As Worksheet, cell As Range, rng As Range
    Dim k As Double, num As Boolean, cad As String
    
    Set sh = Sheets("CASE")
    Set rng = sh.Range("N2", sh.Range("N" & Rows.Count).End(xlUp))
    
    For Each cell In rng
        num = False
        cad = ""
        For k = 1 To Len(cell.Value)
            If Mid(cell.Value, k, 1) Like "[0-9]" Then
                cad = Mid(cell.Value, 1, k)
                num = True
            Else
                If num Then
                    If Mid(cell.Value, k, 1) <> " " Then cad = Mid(cell.Value, 1, k)
                    Exit For
                End If
            End If
        Next
        
        sh.Cells(cell.Row, "Y").Value = cad
        sh.Cells(cell.Row, "Z").Value = WorksheetFunction.Trim(Mid(cell.Value, Len(cad) + 1))
    
    Next
    
    MsgBox "End"
    
End Sub

 

[manosalexo]

Try the following, your data in column N of row 2 down, the results will be in columns Y and Z

Sub Extract_Text()
    Dim sh As Worksheet, cell As Range, rng As Range
    Dim k As Double, num As Boolean, cad As String
    
    Set sh = Sheets("CASE")
    Set rng = sh.Range("N2", sh.Range("N" & Rows.Count).End(xlUp))
    
    For Each cell In rng
        num = False
        cad = ""
        For k = 1 To Len(cell.Value)
            If Mid(cell.Value, k, 1) Like "[0-9]" Then
                cad = Mid(cell.Value, 1, k)
                num = True
            Else
                If num Then
                    If Mid(cell.Value, k, 1) <> " " Then cad = Mid(cell.Value, 1, k)
                    Exit For
                End If
            End If
        Next
        
        sh.Cells(cell.Row, "Y").Value = cad
        sh.Cells(cell.Row, "Z").Value = WorksheetFunction.Trim(Mid(cell.Value, Len(cad) + 1))
    
    Next
    
    MsgBox "End"
    
End Sub

Thanks for answering.
There seems to be a problem with that.
It stops when it finds the first number.
For example it prints:
Kountouri 3
Ag.ioannou 5
Patriarxou makariou 6
Karaoli dimitriou 1

 

[manosalexo]

DanteAmor
Note: i adjusted your code to be like this:


auxC = Trim(auxC)
For k = 1 To Len(auxC)
If Mid(auxC, k, 1) Like "[0-9]" Then
auxC = Mid(auxC, 1, k)
Else
If Mid(auxC, k, 1) <> " " Then cad = Mid(auxC, 1, k)
End If
Next k


destws.Range("Y" & i).Value = auxC
destws.Range("Z" & i).Value = Trim(Mid(auxC, Len(auxC) + 1))

 

[manosalexo]

Ok i just corrected the number values If Mid(cell.Value, k, 1) Like "[0-999]" Then

The problem that remains is that column Z won't print anything at all

 

[DanteAmor]

In post # 2 I asked you for the result, in post # 3 you did not put the result. So I do not know what the expected result is.

 

[manosalexo]

In post # 2 I asked you for the result, in post # 3 you did not put the result. So I do not know what the expected result is.

ok let's see.

I used your code like this

Sub Extract_Text()    Dim sh As Worksheet, cell As Range, rng As Range, rng1 As Range
    Dim k As Double, num As Boolean, cad As String
    
    Set sh = Sheets("cases_P")
    Set rng = sh.Range("Y2", sh.Range("Y" & Rows.Count).End(xlUp))
    
    For Each cell In rng
        num = False
        cad = ""
        For k = 1 To Len(cell.Value)
            If Mid(cell.Value, k, 1) Like "[0-999]" Then
                cad = Mid(cell.Value, 1, k)
                num = True
                
            ElseIf num Then
                'If num Then
                    If Mid(cell.Value, k, 1) <> " " Then cad = Mid(cell.Value, 1, k)
                  '  Else
               ' ElseIf num Then
                     'ElseIf Mid(cell.Value, k, 1) Like "[0-999]" And Mid(cell.Value, k + 2, 1) Like "[0-999]" Then
                   'cad = Mid(cell.Value, 1, k)
                  Exit For
            Else
                cad = cell.Value
           
                 End If
                ' End If
              '  End If
            
            sh.Cells(cell.Row, "Z").Value = WorksheetFunction.Trim(Mid(cell.Value, Len(cad) + 2))
        Next
        
        sh.Cells(cell.Row, "Y").Value = cad
        
    
    Next
    
    MsgBox "End"
    
End Sub

before the coding my column was like this:

[TABLE="width: 340"]
<colgroup><col></colgroup><tbody>[TR]
[TD]ΕΠΙΚΟΥΡΟΥ 31 ΠΕΡΙΣΤΕΡΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΚΑΛΛΙΚΡΑΤΙΔΑ 50 ΠΕΙΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΚΑΛΛΙΚΡΑΤΙΔΑ 50 ΠΕΙΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΑΓΡΙΝΙΟΥ 41 ΓΛΥΦΑΔΑΣ[/TD]
[/TR]
[TR]
[TD]ΛΑΜΠΡΟΥ ΚΑΤΣΩΝΗ 34 ΙΛΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΗΡΩΩΝ ΠΟΛΥΤΕΧΝΕΙΟΥ 23 ΑΓ.ΣΤΕΦΑΝΟΣ[/TD]
[/TR]
[TR]
[TD]ΑΓΙΑΣ ΠΑΡΑΣΚΕΥΗΣ 66 ΧΑΪΔΑΡΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΚΑΝΕΛΛΟΠΟΥΛΟΥ 30 ΑΓΙΑΣ ΒΑΡΒΑΡΑΣ[/TD]
[/TR]
[TR]
[TD]ΠΑΠΑΝΑΣΤΑΣΙΟΥ 84 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΜΑΚΕΔΟΝΙΑΣ 17 ΑΡΓΥΡΟΥΠΟΛΗ[/TD]
[/TR]
[TR]
[TD]ΜΑΚΡΥΓΙΑΝΝΗ 113 ΑΓΙΟΣ ΔΗΜΗΤΡΙΟΣ[/TD]
[/TR]
[TR]
[TD]ΘΗΝΑΙΑΣ 16 ΑΘΗΝΑΙΩΝ[/TD]
[/TR]
[TR]
[TD]ΤΗΝΟΥ 12 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΚΥΠΡΙΩΝ ΗΡΩΩΝ 23 ΗΛΙΟΥΠΟΛΗ[/TD]
[/TR]
[TR]
[TD]ΑΙΓΕΩΣ 7 ΒΟΥΛΑ[/TD]
[/TR]
[TR]
[TD]ΣΚΟΥΦΑ 49 ΑΙΓΑΛΕΩ[/TD]
[/TR]
[TR]
[TD]ΝΙΚΟΛΑΟΥ ΠΛΑΣΤΗΡΑ 84 ΝΕΑΣ ΕΡΥΘΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΣΩΚΡΑΤΟΥΣ 30 ΔΙΟΝΥΣΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΓΙΑΣ ΑΝΝΗΣ 32 ΑΓΙΟΣ ΙΩΑΝΝΗΣ ΡΕΝΤΗΣ[/TD]
[/TR]
[TR]
[TD]ΣΑΠΦΟΥΣ 36 ΚΑΛΛΙΘΕΑ[/TD]
[/TR]
[TR]
[TD]ΔΡΑΜΑΣ 4 ΜΕΛΙΣΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΑΡΓΥΡΗ ΕΦΤΑΛΙΩΤΗ 15 ΑΜΑΡΟΥΣΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΘΗΝΑΓΩΡΟΥ 13 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΔΡΑΓΟΥΜΗ ΙΩΝΟΣ 64 ΠΕΙΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΑΝΑΞΑΓΟΡΑ 7 ΓΕΡΑΚΑΣ[/TD]
[/TR]
[TR]
[TD]ΑΚΡΟΠΟΛΕΩΣ 59 ΝΕΟ ΗΡΑΚΛΕΙΟ[/TD]
[/TR]
[TR]
[TD]ΡΕΑΣ 8 ΚΑΛΛΙΘΕΑ[/TD]
[/TR]
[TR]
[TD]ΚΟΙΜΗΣΕΩΣ ΘΕΟΤΟΚΟΥ 36 ΓΕΡΑΚΑ[/TD]
[/TR]
[TR]
[TD]ΑΡΕΩΣ 42 ΠΑΛΑΙΟΥ ΦΑΛΗΡΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΓ ΙΕΡΟΘΕΟΥ 35 ΠΕΡΙΣΤΕΡΙ[/TD]
[/TR]
[TR]
[TD]ΝΑΥΑΡΙΝΟΥ 6 ΧΟΛΑΡΓΟΣ[/TD]
[/TR]
[TR]
[TD]ΑΛΕΞΑΝΔΡΟΥ ΠΑΝΑΓΟΥΛΗ 24 ΑΓΙΑ ΠΑΡΑΣΚΕΥΗ[/TD]
[/TR]
[TR]
[TD]ΚΟΥΝΤΟΥΡΙΩΤΟΥ 42 ΧΟΛΑΡΓΟΥ[/TD]
[/TR]
[TR]
[TD]ΜΥΚΗΝΩΝ 71 ΜΕΓΑΡΑ[/TD]
[/TR]
[TR]
[TD]ΕΛΑΙΩΝΩΝ 23 ΠΑΛΛΗΝΗΣ[/TD]
[/TR]
[TR]
[TD]ΑΝΤΩΝΙΟΥ ΦΙΞ 18 ΑΘΗΝΑ/ΠΕΥΚΗ[/TD]
[/TR]
[TR]
[TD]ΕΛΕΥΘΕΡΙΑΣ 3Α ΑΓΙΟΣ ΙΩΑΝΝΗΣ ΡΕΝΤΗΣ[/TD]
[/TR]
[TR]
[TD]ΑΡΕΩΣ 51 ΚΗΦΙΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΝΙΚΟΛΑΟΥ ΠΛΑΣΤΗΡΑ 10 ΠΕΥΚΗΣ[/TD]
[/TR]
[TR]
[TD]ΣEBAΣTEIAΣ 58 N ΣMYPNH[/TD]
[/TR]
[TR]
[TD]ΛΕΩΦΟΡΟΣ ΙΩΝΙΑΣ 67 ΑΘΗΝΑΙΩΝ[/TD]
[/TR]
[TR]
[TD]ΣΙΦΝΟΥ 4Β ΒΑΡΗ[/TD]
[/TR]
[TR]
[TD]ΚΑΠΕΤΑΝ ΛΑΧΑΝΑ 33 35 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΣΕΒΔΙΚΙΟΥ 28 ΚΡΥΟΝΕΡΙ[/TD]
[/TR]
[TR]
[TD]ΘΡΑΚΗΣ 56 ΒΡΙΛΗΣΣΙΩΝ[/TD]
[/TR]
[TR]
[TD]ΠΑΠΑΦΛΕΣΣΑ 16 ΙΛΙΟΝ[/TD]
[/TR]
[TR]
[TD]ΠΑΛΑΙΩΝ ΠΑΤΡΩΝ ΓΕΡΜΑΝΟΥ 3 ΠΑΛΑΙΟΥ ΦΑΛΗΡΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΓΙΟΥ ΟΡΟΥΣ 59 ΜΑΡΟΥΣΙ , Ν.ΦΙΛΟΘΕΗ[/TD]
[/TR]
[TR]
[TD]ΛΟΧΑΓΟΥ ΡΕΠΕΤΣΑ 7 ΠΕΙΡΑΙΩΣ[/TD]
[/TR]
[TR]
[TD]ΜΕΓΑΛΟΧΑΡΗΣ 10 ΝΕΑΣ ΜΑΚΡΗΣ[/TD]
[/TR]
[TR]
[TD]ΕΛΕΥΘΕΡΙΟΥ ΒΕΝΙΖΕΛΟΥ 45 ΚΑΜΑΤΕΡΟ[/TD]
[/TR]
[TR]
[TD]AΓIAΣ ΠAPAΣKEYHΣ 45 47 ΠEIPAIAΣ[/TD]
[/TR]
[TR]
[TD]ΛΟΧΑΓΟΥ ΡΕΠΕΤΣΑ 7 ΠΕΙΡΑΙΩΣ[/TD]
[/TR]
[TR]
[TD]ΟΛΥΜΠΟΥ 93 ΑΝΑΒΥΣΣΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΥΡΑΣ 32 ΣΑΡΩΝΙΚΟΥ[/TD]
[/TR]
[TR]
[TD]ΜΠΑΡΟΥΞΗ 56 ΠΕΡΙΣΤΕΡΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΡΕΩΣ 80 ΠΑΛΑΙΟΥ ΦΑΛΗΡΟΥ[/TD]
[/TR]
[TR]
[TD]ΗΡΑΚΛΕΙΤΟΥ 5 ΓΛΥΦΑΔΑΣ[/TD]
[/TR]
[TR]
[TD]ΚΡΙΕΖΗ 59 ΑΜΑΡΟΥΣΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΜΙΑΟΥΛΗ 45 Τ.Θ. 46529 45 ΑΧΑΡΝΕΣ[/TD]
[/TR]
[TR]
[TD]ΗΡΟΔΟΤΟΥ 10 12 ΚΟΡΥΔΑΛΛΟΣ[/TD]
[/TR]
[TR]
[TD]ΠΕΙΣΙΣΤΡΑΤΟΥΣ 8 12 ΑΘΗΝΑΙΩΝ[/TD]
[/TR]
[TR]
[TD]ΗΡΑΚΛΕΙΔΩΝ 36 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΘΕΜΙΣΤΟΚΛΗ ΣΟΦΟΥΛΗ 10 ΝΕΑΣ ΣΜΥΡΝΗΣ[/TD]
[/TR]
[TR]
[TD]Λ.ΒΡΑΒΡΩΝΟΣ 5 ΑΡΤΕΜΙΣ[/TD]
[/TR]
[TR]
[TD]ΔΗΜΗΤΡΙΟΥ ΜΠΙΣΚΙΝΗ 31 ΖΩΓΡΑΦΟΥ[/TD]
[/TR]
[TR]
[TD]ΜΑΚΕΔΟΝΙΑΣ 11 13 ΚΗΦΙΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΛΥΚΑΙΟΥ 42 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΑΓΙΑΣ ΛΑΥΡΑΣ 44 ΝΙΚΑΙΑ[/TD]
[/TR]
[TR]
[TD]ΛΕΣΒΟΥ 2Γ ΝΙΚΑΙΑ[/TD]
[/TR]
[TR]
[TD]ΝΙΚΑΙΑΣ 60 ΝΕΑΣ ΣΜΥΡΝΗΣ[/TD]
[/TR]
[TR]
[TD]ΕΠΙΔΑΥΡΟΥ 42 ΧΑΛΑΝΔΡΙ[/TD]
[/TR]
[TR]
[TD]ΦΡΥΝΗΣ 20 ΝΕΑΣ ΕΡΥΘΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΚΑΝΑΡΗ 3 ΜΕΛΙΣΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΚΡΙΝΩΝ 8 ΚΑΤΩ ΚΗΦΙΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΓΕΩΡΓΙΟΥ ΠΑΠΑΝΔΡΕΟΥ 44 ΝΕΑΣ ΦΙΛΑΔΕΛΦΕΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΑΝΕΞΑΡΤΗΣΙΑΣ 40 ΧΑΪΔΑΡΙ[/TD]
[/TR]
[TR]
[TD]ΑΓΙΑΣ ΤΡΙΑΔΟΣ 9Α ΧΟΛΑΡΓΟΣ[/TD]
[/TR]
[TR]
[TD]ΠΑΥΛΟΥ ΜΕΛΑ 128Β ΑΧΑΡΝΩΝ[/TD]
[/TR]
[TR]
[TD]ΑΛΕΞ ΔΙΑΚΟΥ 23 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΕΠΙΔΑΥΡΟΥ 56 ΧΑΛΑΝΔΡΙ[/TD]
[/TR]
[TR]
[TD]ΑΙΟΛΙΔΟΣ 55 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΑΡΕΩΣ 23 ΜΑΡΟΥΣΙ[/TD]
[/TR]
[TR]
[TD]ΠΛΑΤΩΝΟΣ 24 ΚΗΦΙΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΒΑΣΙΛΕΙΟΥ ΒΟΥΛΓΑΡΟΚΤΟΝΟΥ 10Α ΠΕΥΤΡΟΥΠΟΛΗ[/TD]
[/TR]
[TR]
[TD]ΔΗΜ ΦΑΛΗΡΕΩΣ 28 ΝΕΟ ΦΑΛΗΡΟ[/TD]
[/TR]
[TR]
[TD]Ν ΣΥΡΙΓΟΥ 47 ΛΑΥΡΕΩΤΙΚΗΣ[/TD]
[/TR]
[TR]
[TD]ΣΟΥΛΙΟΥ 58 ΑΓΙΑΣ ΠΑΡΑΣΚΕΥΗΣ[/TD]
[/TR]
[TR]
[TD]Λ ΕΙΡΗΝΗΣ 39 ΑΤΤΙΚΗ

Now i've managed two split it in two columns and the results are these:

[TABLE="width: 548"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]ΗΡΑΚΛΕΙΔΩΝ 36[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΗΡΩΩΝ ΠΟΛΥΤΕΧΝΕΙΟΥ 23[/TD]
[TD]ΑΓ.ΣΤΕΦΑΝΟΣ[/TD]
[/TR]
[TR]
[TD]ΠΥΡΓΙΩΤΙΣΣΗΣ 29[/TD]
[TD]ΠΕΡΙΣΤΕΡΙ[/TD]
[/TR]
[TR]
[TD]ΤΡΥΠΙΑ 26[/TD]
[TD]Β ΠΕΥΚΗ[/TD]
[/TR]
[TR]
[TD]EYΓENΩN 5[/TD]
[TD]ΠEPIΣTEPI[/TD]
[/TR]
[TR]
[TD]ΡΟΔΟΠΗΣ 19[/TD]
[TD]21 ΒΡΙΛΗΣΣΙΑ[/TD]
[/TR]
[TR]
[TD]Α ΜΠΕΡΤΟΥ 29[/TD]
[TD]ΚΕΡΑΤΣΙΝΙΟΥ ΔΡΑΠΕΤΣΩΝΑΣ[/TD]
[/TR]
[TR]
[TD]ΔΕΛΗΓΙΑΝΝΗ 8[/TD]
[TD]ΠΕΙΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΠΟΛΥΒΙΟΥ ΔΗΜΗΤΡΑΚΟΠΟΥΛΟΥ 17[/TD]
[TD]ΑΘΗΝΑΙΩΝ[/TD]
[/TR]
[TR]
[TD]ΚΡΙΕΖΗ 54[/TD]
[TD]ΜΑΡΟΥΣΙ[/TD]
[/TR]
[TR]
[TD]ΙΑΣΟΝΟΣ 2[/TD]
[TD]ΠΑΛΑΙΟΥ ΦΑΛΗΡΟΥ[/TD]
[/TR]
[TR]
[TD]ΣΠΟΡΓΙΛΟΥ 10[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΑΝΘΕΩΝ 4[/TD]
[TD]ΑΓΙΑΣ ΠΑΡΑΣΚΕΥΗΣ[/TD]
[/TR]
[TR]
[TD]ΣΕΒΑΣΤΙΑΣ 33[/TD]
[TD]ΝΕΑ ΣΜΥΡΝΗ[/TD]
[/TR]
[TR]
[TD]ΜΑΥΡΟΚΟΡΔΑΤΟΥ 69[/TD]
[TD]ΠΕΙΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΚΟΜΝΗΝΩΝ ΑΡΓΟΝΑΥΤΩΝ 5[/TD]
[TD]ΔΡΟΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΑΧΙΛΛΕΩΣ 4[/TD]
[TD]ΗΡΑΚΛΕΙΟ[/TD]
[/TR]
[TR]
[TD]ΤΙΜΙΟΥ ΣΤΑΥΡΟΥ 14[/TD]
[TD]ΑΧΑΡΝΕΣ[/TD]
[/TR]
[TR]
[TD]ΑΙΣΧΥΛΟΥ 6Α[/TD]
[TD]ΚΗΦΙΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΧΡΥΣΑΝΘΕΜΩΝ 1[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΜΠΙΖΑΝΙΟΥ 54[/TD]
[TD]ΙΛΙΟΝ[/TD]
[/TR]
[TR]
[TD]ΚΡΗΤΗΣ 27[/TD]
[TD]ΑΛΙΜΟΣ[/TD]
[/TR]
[TR]
[TD]Τ.Θ. 24042[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΜΙΑΟΥΛΗ 8[/TD]
[TD]ΜΑΡΟΥΣΙ[/TD]
[/TR]
[TR]
[TD]ΑΧΙΛΛΕΩΣ 4[/TD]
[TD]ΗΡΑΚΛΕΙΟ[/TD]
[/TR]
[TR]
[TD]ΠΑΛΑΙΩΝ ΠΑΤΡΩΝ ΓΕΡΜΑΝΟΥ 8[/TD]
[TD]Β ΝΙΚΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΣΠΑΡΤΗΣ 81[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΑΛΕΞΑΝΔΡΕΙΑΣ 35[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΚΕΡΚΥΡΑΣ 50[/TD]
[TD]ΠΕΤΡΟΥΠΟΛΕΩΣ[/TD]
[/TR]
[TR]
[TD]ΑΓΙΑΣ ΠΑΡΑΣΚΕΥΗΣ 66[/TD]
[TD]ΧΑΪΔΑΡΙΟΥ[/TD]
[/TR]
[TR]
[TD]Λ. ΑΛΕΞΑΝΔΡΑΣ 213Α[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΗΡΩΩΝ ΠΟΛΥΤΕΧΝΕΙΟΥ 23[/TD]
[TD]ΑΓ.ΣΤΕΦΑΝΟΣ[/TD]
[/TR]
[TR]
[TD]ΘΑΝΟΥ ΣΙΩΚΟΥ 3[/TD]
[TD]ΑΓΙΑ ΠΑΡΑΣΚΕΥΗ[/TD]
[/TR]
[TR]
[TD]ΘΙΣΒΗΣ & ΣΑΛΑΜΙΝΟΣ 05[/TD]
[TD]ΑΝΩ ΛΙΟΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΕΠΙΚΟΥΡΟΥ 31[/TD]
[TD]ΠΕΡΙΣΤΕΡΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΚΑΛΛΙΚΡΑΤΙΔΑ 50[/TD]
[TD]ΠΕΙΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΚΑΛΛΙΚΡΑΤΙΔΑ 50[/TD]
[TD]ΠΕΙΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΑΓΡΙΝΙΟΥ 41[/TD]
[TD]ΓΛΥΦΑΔΑΣ[/TD]
[/TR]
[TR]
[TD]ΛΑΜΠΡΟΥ ΚΑΤΣΩΝΗ 34[/TD]
[TD]ΙΛΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΗΡΩΩΝ ΠΟΛΥΤΕΧΝΕΙΟΥ 23[/TD]
[TD]ΑΓ.ΣΤΕΦΑΝΟΣ[/TD]
[/TR]
[TR]
[TD]ΑΓΙΑΣ ΠΑΡΑΣΚΕΥΗΣ 66[/TD]
[TD]ΧΑΪΔΑΡΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΚΑΝΕΛΛΟΠΟΥΛΟΥ 30[/TD]
[TD]ΑΓΙΑΣ ΒΑΡΒΑΡΑΣ[/TD]
[/TR]
[TR]
[TD]ΠΑΠΑΝΑΣΤΑΣΙΟΥ 84[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΜΑΚΕΔΟΝΙΑΣ 17[/TD]
[TD]ΑΡΓΥΡΟΥΠΟΛΗ[/TD]
[/TR]
[TR]
[TD]ΜΑΚΡΥΓΙΑΝΝΗ 113[/TD]
[TD]ΑΓΙΟΣ ΔΗΜΗΤΡΙΟΣ[/TD]
[/TR]
[TR]
[TD]ΘΗΝΑΙΑΣ 16[/TD]
[TD]ΑΘΗΝΑΙΩΝ[/TD]
[/TR]
[TR]
[TD]ΤΗΝΟΥ 12[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΚΥΠΡΙΩΝ ΗΡΩΩΝ 23[/TD]
[TD]ΗΛΙΟΥΠΟΛΗ[/TD]
[/TR]
[TR]
[TD]ΑΙΓΕΩΣ 7[/TD]
[TD]ΒΟΥΛΑ[/TD]
[/TR]
[TR]
[TD]ΣΚΟΥΦΑ 49[/TD]
[TD]ΑΙΓΑΛΕΩ[/TD]
[/TR]
[TR]
[TD]ΝΙΚΟΛΑΟΥ ΠΛΑΣΤΗΡΑ 84[/TD]
[TD]ΝΕΑΣ ΕΡΥΘΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΣΩΚΡΑΤΟΥΣ 30[/TD]
[TD]ΔΙΟΝΥΣΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΓΙΑΣ ΑΝΝΗΣ 32[/TD]
[TD]ΑΓΙΟΣ ΙΩΑΝΝΗΣ ΡΕΝΤΗΣ[/TD]
[/TR]
[TR]
[TD]ΣΑΠΦΟΥΣ 36[/TD]
[TD]ΚΑΛΛΙΘΕΑ[/TD]
[/TR]
[TR]
[TD]ΔΡΑΜΑΣ 4[/TD]
[TD]ΜΕΛΙΣΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΑΡΓΥΡΗ ΕΦΤΑΛΙΩΤΗ 15[/TD]
[TD]ΑΜΑΡΟΥΣΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΘΗΝΑΓΩΡΟΥ 13[/TD]
[TD]ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΔΡΑΓΟΥΜΗ ΙΩΝΟΣ 64[/TD]
[TD]ΠΕΙΡΑΙΑΣ[/TD]
[/TR]
[TR]
[TD]ΑΝΑΞΑΓΟΡΑ 7[/TD]
[TD]ΓΕΡΑΚΑΣ[/TD]
[/TR]
[TR]
[TD]ΑΚΡΟΠΟΛΕΩΣ 59[/TD]
[TD]ΝΕΟ ΗΡΑΚΛΕΙΟ[/TD]
[/TR]
[TR]
[TD]ΡΕΑΣ 8[/TD]
[TD]ΚΑΛΛΙΘΕΑ[/TD]
[/TR]
[TR]
[TD]ΚΟΙΜΗΣΕΩΣ ΘΕΟΤΟΚΟΥ 36[/TD]
[TD]ΓΕΡΑΚΑ[/TD]
[/TR]
[TR]
[TD]ΑΡΕΩΣ 42[/TD]
[TD]ΠΑΛΑΙΟΥ ΦΑΛΗΡΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΓ ΙΕΡΟΘΕΟΥ 35[/TD]
[TD]ΠΕΡΙΣΤΕΡΙ[/TD]
[/TR]
[TR]
[TD]ΝΑΥΑΡΙΝΟΥ 6[/TD]
[TD]ΧΟΛΑΡΓΟΣ[/TD]
[/TR]
[TR]
[TD]ΑΛΕΞΑΝΔΡΟΥ ΠΑΝΑΓΟΥΛΗ 24[/TD]
[TD]ΑΓΙΑ ΠΑΡΑΣΚΕΥΗ[/TD]
[/TR]
[TR]
[TD]ΚΟΥΝΤΟΥΡΙΩΤΟΥ 42[/TD]
[TD]ΧΟΛΑΡΓΟΥ[/TD]
[/TR]
[TR]
[TD]ΜΥΚΗΝΩΝ 71[/TD]
[TD]ΜΕΓΑΡΑ[/TD]
[/TR]
[TR]
[TD]ΕΛΑΙΩΝΩΝ 23[/TD]
[TD]ΠΑΛΛΗΝΗΣ[/TD]
[/TR]
[TR]
[TD]ΑΝΤΩΝΙΟΥ ΦΙΞ 18[/TD]
[TD]ΑΘΗΝΑ/ΠΕΥΚΗ[/TD]
[/TR]
[TR]
[TD]ΕΛΕΥΘΕΡΙΑΣ 3Α[/TD]
[TD]ΑΓΙΟΣ ΙΩΑΝΝΗΣ ΡΕΝΤΗΣ[/TD]
[/TR]
[TR]
[TD]ΑΡΕΩΣ 51[/TD]
[TD]ΚΗΦΙΣΙΑ[/TD]
[/TR]
[TR]
[TD]ΝΙΚΟΛΑΟΥ ΠΛΑΣΤΗΡΑ 10[/TD]
[TD]ΠΕΥΚΗΣ[/TD]
[/TR]
[TR]
[TD]ΣEBAΣTEIAΣ 58[/TD]
[TD]N ΣMYPNH[/TD]
[/TR]
[TR]
[TD]ΛΕΩΦΟΡΟΣ ΙΩΝΙΑΣ 67[/TD]
[TD]ΑΘΗΝΑΙΩΝ[/TD]
[/TR]
[TR]
[TD]ΣΙΦΝΟΥ 4Β[/TD]
[TD]ΒΑΡΗ[/TD]
[/TR]
[TR]
[TD]ΚΑΠΕΤΑΝ ΛΑΧΑΝΑ 33[/TD]
[TD]35 ΑΘΗΝΑ[/TD]
[/TR]
[TR]
[TD]ΣΕΒΔΙΚΙΟΥ 28[/TD]
[TD]ΚΡΥΟΝΕΡΙ[/TD]
[/TR]
[TR]
[TD]ΘΡΑΚΗΣ 56[/TD]
[TD]ΒΡΙΛΗΣΣΙΩΝ[/TD]
[/TR]
[TR]
[TD]ΠΑΠΑΦΛΕΣΣΑ 16[/TD]
[TD]ΙΛΙΟΝ[/TD]
[/TR]
[TR]
[TD]ΠΑΛΑΙΩΝ ΠΑΤΡΩΝ ΓΕΡΜΑΝΟΥ 3[/TD]
[TD]ΠΑΛΑΙΟΥ ΦΑΛΗΡΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΓΙΟΥ ΟΡΟΥΣ 59[/TD]
[TD]ΜΑΡΟΥΣΙ , Ν.ΦΙΛΟΘΕΗ[/TD]
[/TR]
[TR]
[TD]ΛΟΧΑΓΟΥ ΡΕΠΕΤΣΑ 7[/TD]
[TD]ΠΕΙΡΑΙΩΣ[/TD]
[/TR]
[TR]
[TD]ΜΕΓΑΛΟΧΑΡΗΣ 10[/TD]
[TD]ΝΕΑΣ ΜΑΚΡΗΣ[/TD]
[/TR]
[TR]
[TD]ΕΛΕΥΘΕΡΙΟΥ ΒΕΝΙΖΕΛΟΥ 45[/TD]
[TD]ΚΑΜΑΤΕΡΟ[/TD]
[/TR]
[TR]
[TD]AΓIAΣ ΠAPAΣKEYHΣ 45[/TD]
[TD]47 ΠEIPAIAΣ[/TD]
[/TR]
[TR]
[TD]ΛΟΧΑΓΟΥ ΡΕΠΕΤΣΑ 7[/TD]
[TD]ΠΕΙΡΑΙΩΣ[/TD]
[/TR]
[TR]
[TD]ΟΛΥΜΠΟΥ 93[/TD]
[TD]ΑΝΑΒΥΣΣΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΥΡΑΣ 32[/TD]
[TD]ΣΑΡΩΝΙΚΟΥ[/TD]
[/TR]
[TR]
[TD]ΜΠΑΡΟΥΞΗ 56[/TD]
[TD]ΠΕΡΙΣΤΕΡΙΟΥ[/TD]
[/TR]
[TR]
[TD]ΑΡΕΩΣ 80[/TD]
[TD]ΠΑΛΑΙΟΥ ΦΑΛΗΡΟΥ[/TD]
[/TR]
[TR]
[TD]ΗΡΑΚΛΕΙΤΟΥ 5[/TD]
[TD]ΓΛΥΦΑΔΑΣ[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]


As you can see i'm still missing a few. Some may have two numbers with a space between them like for example : 12 14
Or some of the may have a letter with a space like 13A or 13 A.
Is there a way to correct this?
Thank you for answering

 

[manosalexo]

Update!!!

I've managed to get all the numbers now the only problem left is if after the number there is a space and only one word i want it to stay in the same column.
For example:

Aristotelous 23 A Athens
Giannitson 55 B Larissa
After using code it goes like this
Aristotelous 23 A Athens
Giannitson 55 B Larissa


The code right now looks like this:

Sub Extract_Text()    Dim sh As Worksheet, cell As Range, rng As Range, rng1 As Range
    Dim k As Double, num As Boolean, cad As String
    
    Set sh = Sheets("cases_P")
    Set rng = sh.Range("Y2", sh.Range("Y" & Rows.Count).End(xlUp))
    
    For Each cell In rng
        num = False
        cad = ""
        For k = 1 To Len(cell.Value)
            If Mid(cell.Value, k, 1) Like "[0-999]" Then
                cad = Mid(cell.Value, 1, k)
                num = True
        'sh.Cells(cell.Row, "Z").Value = WorksheetFunction.Trim(Mid(cell.Value, Len(cad) + 2))
            
            ElseIf num Then
            If Mid(cell.Value, k + 1, 1) Like " ""[0-999]" Then
            cad = Mid(cell.Value, 1, k)
            End If
            
             ElseIf num Then
            If Mid(cell.Value, k + 1, 1) Like " ""[A-Z]" Then
            cad = Mid(cell.Value, 1, k)
            End If
            
            ElseIf num Then
                
                    If Mid(cell.Value, k, 1) <> " " Then cad = Mid(cell.Value, 1, k)
                    'sh.Cells(cell.Row, "Z").Value = WorksheetFunction.Trim(Mid(cell.Value, Len(cad) + 2))
                   


                  Exit For
            Else
                cad = cell.Value
           
                 End If
                ' End If
              '  End If
            
            sh.Cells(cell.Row, "Z").Value = WorksheetFunction.Trim(Mid(cell.Value, Len(cad) + 1))
        Next
        
        sh.Cells(cell.Row, "Y").Value = cad
        
    
    Next
    
    MsgBox "End"
    
End Sub