keisuke_z
04-24-2007, 06:13 PM
Hello! As part of our project, we need to write a macro that goes through a spreadsheet and inserts "divider rows." For simplicity's sake, let's say my data is in a single column of the spreadsheet, and it's a list of single letters that are already sorted from A-Z, top to bottom. However, the list *may* not start with A, or end with Z, and may be missing various letters throughout. In other words, it's a non-comprehensive list of letters that are sorted alphabetically, and there may be more than 1 instance of a letter, ie, "A,A,B,B,B,B,E,E,E,G,H,I,M,P,S,V"
The output of the macro needs to look like this:
New A
A
A
New B
B
B
B
B
New C
New D
New E
E
E
E
New F
F
New G
G
New H
New I
New J
New K
...
and so on... here is what I've been able to come up with so far, but it's not working quite right and I don't feel confident that I'm on the right path:
currWorksheet = ActiveCell.Worksheet.Name
Range("A1").Select
ActiveCell.CurrentRegion.Select
Set UserRange = Selection
'*******************************************************************'
'>>>> Builds array to store letters <<<<
code = Asc("A") ' Starts at "A"
For i = 0 To 25
arrLetters(i) = Chr(code)
code = code + 1
Next i
i = 0 ' Reset index in reference table
'*******************************************************************'
'Inserts section dividers throughout body of document
'Insert first section divider for 'A'
Rows("2:2").Select
Selection.Insert Shift:=xlDown 'Inserts new row above second row
'Write section divider: Document_ID = "New", Document_Title = Letter
UserRange.Cells(2, 1) = "New"
UserRange.Cells(2, 2) = arrLetters(0)
UserRange.Cells(2, 3) = "Null"
NumRows = UserRange.Rows.Count 'Row count plus alphabet (minus A) in spreadsheet
i = i + 1 'current letter = B
rw = 3 'starting row at 3 in lieu of inserted "A" divider
rowID = UserRange.Cells(rw, 1).Value
Do Until rowID = ""
rowID = UserRange.Cells(rw, 1).Value
rowCode = Asc(rowID)
ltrCode = Asc(arrLetters(i))
If rowCode > ltrCode Then
For x = ltrCode To rowCode
'Inserts new row above current row
Rows(rw & ":" & rw).Select
Selection.Insert Shift:=xlDown
'Write section divider in first cell of newly inserted row
UserRange.Cells(rw, 1) = "New"
UserRange.Cells(rw, 2) = arrLetters(i)
UserRange.Cells(rw, 3) = "Null"
i = i + 1
rw = rw + 1
Next x
Else
rw = rw + 1
End If
Loop
If i < 26 Then
For j = i To 26
Rows(rw & ":" & rw).Select
Selection.Insert Shift:=xlDown
'Write section divider in first cell of newly inserted row
UserRange.Cells(rw, 1) = "New"
UserRange.Cells(rw, 2) = arrLetters(j)
UserRange.Cells(rw, 3) = "Null"
Next j
End If
That last If...Else tries to account for letters that may have been missed... as in, the program reaches the end of data in Excel but has not reached the end of the alphabet yet...
Can anybody offer some help? = ( I've been wracking my brains about this for weeks now...
Thanks...
The output of the macro needs to look like this:
New A
A
A
New B
B
B
B
B
New C
New D
New E
E
E
E
New F
F
New G
G
New H
New I
New J
New K
...
and so on... here is what I've been able to come up with so far, but it's not working quite right and I don't feel confident that I'm on the right path:
currWorksheet = ActiveCell.Worksheet.Name
Range("A1").Select
ActiveCell.CurrentRegion.Select
Set UserRange = Selection
'*******************************************************************'
'>>>> Builds array to store letters <<<<
code = Asc("A") ' Starts at "A"
For i = 0 To 25
arrLetters(i) = Chr(code)
code = code + 1
Next i
i = 0 ' Reset index in reference table
'*******************************************************************'
'Inserts section dividers throughout body of document
'Insert first section divider for 'A'
Rows("2:2").Select
Selection.Insert Shift:=xlDown 'Inserts new row above second row
'Write section divider: Document_ID = "New", Document_Title = Letter
UserRange.Cells(2, 1) = "New"
UserRange.Cells(2, 2) = arrLetters(0)
UserRange.Cells(2, 3) = "Null"
NumRows = UserRange.Rows.Count 'Row count plus alphabet (minus A) in spreadsheet
i = i + 1 'current letter = B
rw = 3 'starting row at 3 in lieu of inserted "A" divider
rowID = UserRange.Cells(rw, 1).Value
Do Until rowID = ""
rowID = UserRange.Cells(rw, 1).Value
rowCode = Asc(rowID)
ltrCode = Asc(arrLetters(i))
If rowCode > ltrCode Then
For x = ltrCode To rowCode
'Inserts new row above current row
Rows(rw & ":" & rw).Select
Selection.Insert Shift:=xlDown
'Write section divider in first cell of newly inserted row
UserRange.Cells(rw, 1) = "New"
UserRange.Cells(rw, 2) = arrLetters(i)
UserRange.Cells(rw, 3) = "Null"
i = i + 1
rw = rw + 1
Next x
Else
rw = rw + 1
End If
Loop
If i < 26 Then
For j = i To 26
Rows(rw & ":" & rw).Select
Selection.Insert Shift:=xlDown
'Write section divider in first cell of newly inserted row
UserRange.Cells(rw, 1) = "New"
UserRange.Cells(rw, 2) = arrLetters(j)
UserRange.Cells(rw, 3) = "Null"
Next j
End If
That last If...Else tries to account for letters that may have been missed... as in, the program reaches the end of data in Excel but has not reached the end of the alphabet yet...
Can anybody offer some help? = ( I've been wracking my brains about this for weeks now...
Thanks...