PDA

View Full Version : Help! Insert row based on row values...



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...

Charlize
04-25-2007, 01:25 AM
1. store letters in array. Since you know the letters (a,b,c ...) why that asc-thing. Declare array of 26 as a string. Loop from 0 to 25 to store them from z to a because list is sorted in sheet (for each loop for every item in array of letters to store to array of 26).
2. when inserting rows, try to do it from last row to top row. achieving succes is must greater this way.
3. check last row value. if not = 1st item in array of letters then insert row, copy row+1 to row and row+1 becomes New + arrayletter(item x). Item x is a counter for the item in the array of letters starting at 0.
4. since you just inserted a row and we need to loop through every item in worksheet the loop is + 1 (we do this with vloop = lrow to 2 step - 1).
5. when letter on sheet = letter in array we skip letter in array because it's present in sheet. check previous value if it is = lrow value. if true then vloop = vloop -1. if not insert row and add New + row+1.value.

Charlize