MISSION IMPOSSIBLE

[sal21]

how to transpose the value of column A in the column B to H...


note:
- The CITY name are always in lower case
- PR is the auto id TO =Torino, NA = Napoli... ecc
- REGIONE PIE=PIEMONTE CAM=CAMPANIA...ecc
- PHONE PREFIX
- ZIP code
- ISTAT Id city

[HansV]

Run this macro:

Code: Select all

Sub SplitData()
    Dim r As Long
    Dim m As Long
    Dim v As Variant
    Dim s As String
    Dim p1 As Long
    Dim p2 As Long
    Application.ScreenUpdating = False
    m = Range("A" & Rows.Count).End(xlUp).Row
    v = Range("A1:H" & m).Value
    For r = 1 To m
        s = v(r, 1)
        p1 = InStrRev(s, " ")
        v(r, 8) = Mid(s, p1 + 1)
        p2 = p1
        p1 = InStrRev(s, " ", p2 - 1)
        v(r, 7) = Mid(s, p1 + 1, p2 - p1 - 1)
        p2 = p1
        p1 = InStrRev(s, " ", p2 - 1)
        v(r, 6) = Mid(s, p1 + 1, p2 - p1 - 1)
        p2 = p1
        p1 = InStrRev(s, " ", p2 - 1)
        v(r, 5) = Mid(s, p1 + 1, p2 - p1 - 1)
        p2 = p1
        p1 = InStrRev(s, " ", p2 - 1)
        v(r, 4) = Mid(s, p1 + 1, p2 - p1 - 1)
        p2 = p1
        p1 = InStr(s, " ")
        v(r, 3) = Mid(s, p1 + 1, p2 - p1 - 1)
        v(r, 2) = Left(s, p1 - 1)
    Next r
    Range("A1:H" & m).Value = v
    Range("A1:H1").EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

[sal21]

Run this macro:

Code: Select all

Sub SplitData()
    Dim r As Long
    Dim m As Long
    Dim v As Variant
    Dim s As String
    Dim p1 As Long
    Dim p2 As Long
    Application.ScreenUpdating = False
    m = Range("A" & Rows.Count).End(xlUp).Row
    v = Range("A1:H" & m).Value
    For r = 1 To m
        s = v(r, 1)
        p1 = InStrRev(s, " ")
        v(r, 8) = Mid(s, p1 + 1)
        p2 = p1
        p1 = InStrRev(s, " ", p2 - 1)
        v(r, 7) = Mid(s, p1 + 1, p2 - p1 - 1)
        p2 = p1
        p1 = InStrRev(s, " ", p2 - 1)
        v(r, 6) = Mid(s, p1 + 1, p2 - p1 - 1)
        p2 = p1
        p1 = InStrRev(s, " ", p2 - 1)
        v(r, 5) = Mid(s, p1 + 1, p2 - p1 - 1)
        p2 = p1
        p1 = InStrRev(s, " ", p2 - 1)
        v(r, 4) = Mid(s, p1 + 1, p2 - p1 - 1)
        p2 = p1
        p1 = InStr(s, " ")
        v(r, 3) = Mid(s, p1 + 1, p2 - p1 - 1)
        v(r, 2) = Left(s, p1 - 1)
    Next r
    Range("A1:H" & m).Value = v
    Range("A1:H1").EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

[Doc.AElstein]

Hello
When I took an initial look at the data, it suggested to me this might be a nice example to use the “unjagged jagged 1 D array in Index” ideas** to solve this.

But the second data ( CITY ) messes it all up a bit since there may be 1 – 3 words in it.
The extra workaround for that is a bit messy. Never the less, the total steps in the loop can be reduced a bit, so here for comparison is my offering: ( three versions of the same basic macro, here the basic form)

Code: Select all

 Sub VergeltungswaffeV1V2() ' http://www.eileenslounge.com/viewtopic.php?f=27&t=36401
Dim Ar As Long, Em As Long
 Let Em = Range("A" & Rows.Count).End(xlUp).Row
Dim A() As Variant: Let A() = Range("A1:A" & Em & "").Value2 '   The main data from column 1
Dim V1() As Variant, V2() As Variant: ReDim V1(1 To Em): ReDim V2(1 To Em) ' These will need to be variant because each element is itself an array  ( a 1 D array )
    For Ar = 1 To Em ' The main data rows range
     Let V1(Ar) = Split(A(Ar, 1), " ", 2, vbBinaryCompare)              '  I am splitting each data into 2 bits, the first is the data  ID  the second is all the rest
     Let V2(Ar) = Split(StrReverse(V1(Ar)(1)), " ", 6, vbBinaryCompare) '  We are splitting the reversed string, because my second data  CITY  might have a few words, I split the backward string in just enough bits so that the last element is the data  CITY  regardles of how many words are in it
     Let V2(Ar)(0) = StrReverse(V2(Ar)(0)): V2(Ar)(1) = StrReverse(V2(Ar)(1)): V2(Ar)(2) = StrReverse(V2(Ar)(2)): V2(Ar)(3) = StrReverse(V2(Ar)(3)): V2(Ar)(4) = StrReverse(V2(Ar)(4)): V2(Ar)(5) = StrReverse(V2(Ar)(5)) '  The problem with the last line is that all my data words and data numbers are in reverse , so I need to put each data back the correct way around
    Next Ar
' The end result of the above is that we have two 1 D arrays, V1() and V2(). Each element is itself a 1 D array. We find that strangely that  INDEX  seems to treat such arrays as like 2 D arrays as long as all the 1 D array elements have the same number of elements. This allows us to use the  Index(arr(), Rws(), Clms())  way to get out our final range in any order we like.
 Let Range("B2:B" & Em + 1 & "").Value = Application.Index(V1(), Evaluate("=Row(1:" & Em & ")"), Array(1)) ' We only want the first column from V1()
 Let Range("C2:H" & Em + 1 & "").Value = Application.Index(V2(), Evaluate("=Row(1:" & Em & ")"), Array(6, 5, 4, 3, 2, 1)) ' We want all the data columns from V2() but need them in the reverse order because we split the reversed string
 Range("A1:H1").EntireColumn.AutoFit
End Sub

Here all three macros:
https://excelfox.com/forum/showthread.p ... #post15508

_.___

The solutions above involve 1 D array of arrays, so we can conveniently use dictionary things as an alternative where items are the 1 D array, since then we can obtain an array of items which will be our array of arrays. So we can make a slight variation of the above macros thus:
https://excelfox.com/forum/showthread.p ... #post15509

_.____

As we are dealing with simple lists we can do a similar solutions using Array Lists.
Example:
https://excelfox.com/forum/showthread.p ... #post15510


_._______

In the uploaded file below are some speed tests. I only looked briefly, but at first look, my offerings seem slower than Han’s original. The first three aren’t too bad, but the Dictionary and Array list versions are pretty slow.
It seems that simple array manipulation in VBA is often quite quick.
The performance of the macro alternatives I’ve done is generally pretty disappointing, but I thought I would post anyway for comparison and future reference,

Alan

_._______________________________

GetCartel.xls https://app.box.com/s/qkgmelqei5pxj18t8rhk6vs43rp3p1s2


_._______________________________________


** Ref 1 D array of arrays
https://eileenslounge.com/viewtopic.php ... 91#p266691
https://eileenslounge.com/viewtopic.php ... 67#p274367
https://www.ozgrid.com/forum/index.php? ... ost1239241
https://www.excelforum.com/excel-progra ... ost5410028


Ref ArrayLists
http://www.snb-vba.eu/VBA_Arraylist_en.html#L_0