CODEWITHSUNDEEP
vbaexceldictionary
Sulot
Sulot

Reputation: 514

VBA: How to transform a one column full dictionary into one column per letter?

I have a full dictionary. All the words (360 000) are in one column.

I'd like to have Column B with all words starting with "a", column C with all words starting with b...

I am trying to do a loop or something... but... It is just too long.

Any tips? Or did someone already do this vba macro?

Tks,

Stéphane.

Upvotes: 0

Views: 235

Answers (4)

Paresh J
Paresh J

Reputation: 2419

You can enter the following formula:

For letter A in B Column: =IF(UPPER(LEFT(A1,1))="A",A1,"")

For letter B in C Column: =IF(UPPER(LEFT(A1,1))="B",A1,"")

Repeat the same for letter C, D and so on..

Upvotes: 0

Gary's Student
Gary's Student

Reputation: 96753

If we start with:

enter image description here

Running this short macro:

Sub SeparateData()
    Dim N As Long, i As Long, NewCol As Long
    Dim M As Long
    N = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To N
        NewCol = Asc(UCase(Left(Cells(i, 1).Value, 1))) - 63
        If Cells(1, NewCol).Value = "" Then
            M = 1
        Else
            M = Cells(Rows.Count, NewCol).End(xlUp).Row + 1
        End If
        Cells(M, NewCol).Value = Cells(i, 1).Value
    Next i
End Sub

will produce:

enter image description here

NOTE:

You may want to add some error capture logic to the NewCol calculation line.

EDIT#1:

This version may be slightly faster:

Sub SeparateDataFaster()
    Dim N As Long, i As Long, NewCol As Long
    Dim M As Long, time1 As Date, time2 As Date
    N = Cells(Rows.Count, 1).End(xlUp).Row
    time1 = Now
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For i = 1 To N
        NewCol = Asc(UCase(Left(Cells(i, 1).Value, 1))) - 63
        If Cells(1, NewCol).Value = "" Then
            M = 1
        Else
            M = Cells(Rows.Count, NewCol).End(xlUp).Row + 1
        End If
        Cells(M, NewCol).Value = Cells(i, 1).Value
    Next i
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    time2 = Now
    MsgBox time1 & vbCrLf & time2
End Sub

Upvotes: 3

Dawid
Dawid

Reputation: 786

You can try something like this. For 360k records its take about 20sec.

To create tests data i use this sub:

Sub FillTestData()

Dim t As Long
Dim lng As Integer
Dim text As String

'Start = Timer

For t = 1 To 360000
text = vbNullString
lng = 5 * Rnd + 10
    For i = 1 To lng
    Randomize
    text = text & Chr(Int((26 * Rnd) + 65))
    Next i
    Cells(t, 1) = text
Next t

'Debug.Print Timer - Start

End Sub

And for separate:

Sub sep()

'Start = Timer
Dim ArrWords() As Variant
Dim Row_ As Long

LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
ArrWords = Range("A1:A" & LastRow) 'all data from column A to array

For i = 65 To 90 ' from A to Z
    Row_ = 1
    For j = LBound(ArrWords, 1) To UBound(ArrWords, 1)
        If Asc(UCase(ArrWords(j, 1))) = i Then
        Cells(Row_, i - 63) = ArrWords(j, 1)
        Row_ = Row_ + 1
        End If
    Next j
Next i

'other than a[A]-z[Z]
Row_ = 1
For j = LBound(ArrWords, 1) To UBound(ArrWords, 1)
    If Asc(UCase(ArrWords(j, 1))) < 65 Or Asc(UCase(ArrWords(j, 1))) > 90 Then
        Cells(Row_, 28) = ArrWords(j, 1)
        Row_ = Row_ + 1
    End If
Next j

'Debug.Print Timer - Start
End Sub

Upvotes: 1

SierraOscar
SierraOscar

Reputation: 17637

You could try: 

For i = 1 To Cells(Rows.count, 1).End(xlUp).Row
    Range(UCase(Left$(Cells(i, 1).Text, 1)) & Rows.count).Offset(0, 1).End(xlUp).Offset(IIf(Range(UCase(Left$(Cells(i, _
    1).Text, 1)) & Rows.count).Offset(0, 1).End(xlUp).Row = 1, 0, 1), 0).Value = Cells(i, 1).Text
Next i

Which is just building the destination address using the first letter of the word by doing the following:

  • Loop through each cell in column A
  • Get the first letter of that cell and convert it to upper case
  • Find the last cell in the column starting with that letter
  • Move over 1 column to the right
  • Go up until we hit the last row of data
  • If the last row isn't row 1, move down another row (next blank cell)
  • Give this cell the same value as the cell in column A that we're assessing

Upvotes: 0

Related Questions