Find,count, copy & transpose loop macro...perhaps?

[pierre robinson]

OK.

So I have been given a list of 18000 rows in the following format

[TABLE="width: 85"]
<tbody>[TR]
[TD="class: xl65, width: 85"]ABC5016[/TD]
[/TR]
[TR]
[TD="class: xl66"]B21[/TD]
[/TR]
[TR]
[TD="class: xl66"]C833[/TD]
[/TR]
[TR]
[TD="class: xl66"]J069[/TD]
[/TR]
[TR]
[TD="class: xl66"]R222[/TD]
[/TR]
[TR]
[TD="class: xl66"]R4589[/TD]
[/TR]
[TR]
[TD="class: xl66"]Z21[/TD]
[/TR]
[TR]
[TD="class: xl65"]DEF0290[/TD]
[/TR]
[TR]
[TD="class: xl66"]D090[/TD]
[/TR]
[TR]
[TD="class: xl66"]R001[/TD]
[/TR]
[TR]
[TD="class: xl66"]Z8643

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

It appears that the 7 digit alpha-numerics are the UID & the shorter alpha-numerics are attributes that append to the UID.

The customer wants a formula (as they put it) that runs thru the 18k lines and transpose the data so that it looks like this in the end:

[TABLE="width: 595"]
<tbody>[TR]
[TD="class: xl65, width: 85"]ABC5016[/TD]
[TD="class: xl66, width: 85"]B21[/TD]
[TD="class: xl66, width: 85"]C833[/TD]
[TD="class: xl66, width: 85"]J069[/TD]
[TD="class: xl66, width: 85"]R222[/TD]
[TD="class: xl66, width: 85"]R4589[/TD]
[TD="class: xl66, width: 85"]Z21[/TD]
[/TR]
[TR]
[TD="class: xl65"]DEF0290[/TD]
[TD="class: xl66"]D090[/TD]
[TD="class: xl66"]R001[/TD]
[TD="class: xl66"]Z8643
[/TD]
[TD][/TD]
[TD][/TD]
[TD]


[/TD]
[/TR]
</tbody>[/TABLE]
My head is in power query at the moment & I havent even got a clue where to start???

The solution gets a bottle of Kiwi wine.,

Cheers

 

[pvr928]

Hi pierre robinson

Try this on for size:

Assumptions:
Data is in one column starting from range A1 in Sheet1
Output is from range A1 in Sheet2
The UID is always seven (7) characters (no spaces, invisible characters) long
The shorter alpha-numeric are never seven (7) characters long

MrExcel doesn't allow consideration for responses, but thanks for the offer. I would have gone for a Marlborough Sauvignon Blanc

I have no doubt gurus like @Rick Rothstein could replicate my code in about 1/5th of the lines, but this certainly works.

Option Explicit
Sub Transpose_data()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lLastRow As Long
Dim aInitialArray()
Dim aRowsArray()
Dim i As Long
Dim ii As Long
Dim iii As Long
Dim iMaxWidth As Integer
Dim aFinalArray()
Set ws1 = Sheet1
Set ws2 = Sheet2
ws2.Cells.Clear
ii = 0
iii = 0
iMaxWidth = 0
lLastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
aInitialArray = Range(ws1.Cells(1, 1), ws1.Cells(lLastRow, 1))
For i = 1 To UBound(aInitialArray)
    If Len(Trim(aInitialArray(i, 1))) = 7 Then
        ii = ii + 1
        ReDim Preserve aRowsArray(1 To 2, 1 To ii)
        aRowsArray(1, ii) = I
        
        If ii > 1 Then
        
            aRowsArray(2, ii) = (aRowsArray(1, ii) - aRowsArray(1, ii - 1)) - 1
        
        Else
        
            aRowsArray(2, ii) = 0
        
        End If
        
        If aRowsArray(2, ii) > iMaxWidth Then iMaxWidth = aRowsArray(2, ii)
        
    Else
    End If
    
Next I
    
For i = 1 To ii
    Debug.Print aRowsArray(1, i), aRowsArray(2, i)
    
Next i
ReDim aFinalArray(1 To UBound(aRowsArray, 2), 1 To iMaxWidth + 1)
For i = 1 To UBound(aRowsArray, 2)
    aFinalArray(i, 1) = aInitialArray(aRowsArray(1, i), 1)
    
Next i
For i = 2 To UBound(aRowsArray, 2)
    
    For ii = 1 To aRowsArray(2, i)
        aFinalArray(i - 1, ii + 1) = aInitialArray(aRowsArray(1, i - 1) + ii, 1)
    
        If i = UBound(aRowsArray, 2) Then
        
            aFinalArray(i, ii + 1) = aInitialArray(aRowsArray(1, i) + ii, 1)
    
        Else
    
        End If
    
    Next ii
Next i
ws2.Range("A1").Resize(UBound(aRowsArray, 2), iMaxWidth + 1) = aFinalArray
End Sub

Cheers

pvr928

 

[pierre robinson]

PVR928. Mate!

I'm going to have to work my way through your code & try and get my head around your solution: dont think I would have been able to work that out!
Ran into one problem with the code - WS2 - the code had a bit of a whine about declaring variables, but I managed to solve that.
In terms of wine, as I cant get a bottle to you, I will recommend the Kim Crawford "Lighter" Sauvignon - definitely 'quaffable' as my Aussie wife says

Cheers from across the ditch.

 

[pvr928]

Hi pierre robinson

Will check out the Kim Crawford. If it Sauvignon Blanc, my wife insists it is either Margaret River or Marlborough !

In a nutshell, the code uses three arrays to process the data.

aInitialArray contains the original data (Multiple rows x 1 column)

aRowsArray identifies the position of each UID and how many non-UID strings are 'in between' each UID (2 rows x multiple columns) (along the way, the maximum 'width' of aRowsArray is determined through the variable iMaxWidth)

aFinalArray then 'repositions' the contents of aInitialArray according to the data picked up in aRowsArray and iMaxWidth (rows = number of UIDs; columns = iMaxWidth)

The code is dynamic, so it takes into account theoretically an infinite number of UIDs, and any number of non-UID strings (except perhaps zero - I haven't tested it for that).

I'm writing the data from the worksheet to an array, processing it in arrays and then writing the data back to the worksheet at the end. This is a much faster way of processing data rather than going back to the worksheet each time you want data or write it back.

Cheers

pvr928