Excel formula/macro

Soldato
Joined
28 Dec 2003
Posts
3,767
Location
Aberwristwatch
Hi. I need a macro to do the following;

Column A is the area code which all address records are sorted by. When this code changes to the next area, I need to insert a row to divide it from the next area and insert *** (three stars) as a visual indication of the change.

A B C
1 abc abc
1 abc abc
1 abc abc
*** *** ***
2 abc abc
 
Something like:

Code:
Sub SplitAddressCodes()
Dim RowsToCheck, i
Dim strAddressCode, strAddressCodeNext
 
RowsToCheck = 34 ' Put how many rows you have here or put a Do Until strAddressCodeNext = "" instead of For
For i = 1 To RowsToCheck
    strAddressCode = Range("A" & i)
    strAddressCodeNext = Range("A" & i + 1)
 
    If strAddressCodeNext <> strAddressCode Then
        Range("A" & i + 1).Select
        Selection.Insert Shift:=xlDown
       Selection.Value = "***"
        ' Add an extra
        RowsToCheck = RowsToCheck + 1
        i = i + 1
    End If
 
Next i
End Sub
 
Last edited:
Hi

Thanks for that. Very nearly. The code seems not to add an extra row, just inserts stars into the cell beneath

joey1211-xls1.jpg


The spreadsheet is to be mail-merged and I want a sheet with *** in the address lines seperating every Selection Code (column C)

joey1211-xls2.jpg
 
DOH! I was being dense. It's inserting a cell into the specific column not the entire row.

Code:
Sub SplitAddressCodes()
Dim RowsToCheck, i
Dim strAddressCode, strAddressCodeNext
 
RowsToCheck = 30 ' Put how many rows you have here or put a Do Until strAddressCodeNext = "" instead of For
For i = 1 To RowsToCheck
    strAddressCode = Range("A" & i)
    strAddressCodeNext = Range("A" & i + 1)
 
    If strAddressCodeNext <> strAddressCode Then
        Rows(i + 1).Select
        Selection.Insert Shift:=xlDown
       Selection.Value = "***"
        ' Add an extra
        RowsToCheck = RowsToCheck + 1
        i = i + 1
    End If
 
Next i
End Sub
 
Back
Top Bottom