Senin, 15 Februari 2016

[MS_AccessPros] OFF TOPIC: MS Excel VBA code

 


I could not find the yahoo MS Excel group email so I am posting here.

I grabbed a list of dictionary words, from 2 to 15 letters long. Each word gets its own row in Excel. Each letter of each word gets its own column in Excel (I parsed the words out via text to columns). Since these words can be up to 15 letters in length that means it is possible to go out to column O in Excel.

I want to take each word in each row and turn it into its "alphagram"
An alphagram is putting each word's letters in alphabetical sort order.
For instance, AARDVARK, would be sorted to AAADKRRV

I have the following VBA code, but it would be real tedious to repeat the same code for each and row up to 187,633 rows of words plus one header row, hence why code starts at row 2.

Is there an easier way? Code is below:

Thank you in advance for any help you can give.

Eric Lutz
---------------------------------------------------

Sub ScrabbleSort()
'
' ScrabbleSort Macro
' sorting letters in a word alphabetically
'

'
Rows("2:2").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A2:O2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A2:O2")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("3:3").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A3:O3"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A3:O3")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("4:4").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A4:O4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A4:O4")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("5:5").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A5:O5"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A5:O5")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("6:6").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A6:O6"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A6:O6")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("7:7").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A7:O7"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A7:O7")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("8:8").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A8:O8"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A8:O8")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("9:9").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A9:O9"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A9:O9")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("10:10").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A10:O10") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A10:O10")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("11:11").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A11:O11") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A11:O11")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("12:12").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A12:O12") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A12:O12")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("13:13").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A13:O13") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A13:O13")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("14:14").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A14:O14") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A14:O14")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("15:15").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A15:O15") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A15:O15")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("16:16").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A16:O16") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A16:O16")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Rows("17:17").Select
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("A17:O17") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").Sort
.SetRange Range("A17:O17")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
End Sub

__._,_.___

Posted by: Barry White <imtigerwords@yahoo.com>
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (1)

.

__,_._,___

Tidak ada komentar:

Poskan Komentar