JJanower
10-26-2011, 02:17 AM
Hi,
I have a big list of Persons with their repective teams, it looks somehow like this
Team1 Person1
Team1 person2
team1 person3
team1 person4
team2 person5
Team2 person6
team2 person7
team2 person8
team3 person9
team3 person10
...
The code that I' ve written inserts one row between each team but I want it to insert 2 rows or even 3, but whenever I change my code to do this, it doesn't work anymore :S. So if you have any suggestions I would be very happy.
here is my code:
Private Sub CommandButton1_Click()
Count = 2
secondcount = 2
For i = 3 To 200
'Inserting a row between teams
If Worksheets("Test").Cells(secondcount, 1) <> Worksheets("Test").Cells(secondcount + 1, 1) Then
Worksheets("Test").Rows(Count + 1 & ":" & Count + 1).Select
Selection.Insert Shift:=xlDown
With Worksheets("Test")
Worksheets("Test").range(Cells(Count, 1), Cells(Count, 1)).Select
Worksheets("Test").range(Selection, Selection.End(xlToRight)).Select
Worksheets("Test").range(Selection, Selection.End(xlUp)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNon
End With
Count = Count + 1
secondcount = secondcount + 1
End If
Count = Count + 1
secondcount = secondcount + 1
Next
End Sub
I have a big list of Persons with their repective teams, it looks somehow like this
Team1 Person1
Team1 person2
team1 person3
team1 person4
team2 person5
Team2 person6
team2 person7
team2 person8
team3 person9
team3 person10
...
The code that I' ve written inserts one row between each team but I want it to insert 2 rows or even 3, but whenever I change my code to do this, it doesn't work anymore :S. So if you have any suggestions I would be very happy.
here is my code:
Private Sub CommandButton1_Click()
Count = 2
secondcount = 2
For i = 3 To 200
'Inserting a row between teams
If Worksheets("Test").Cells(secondcount, 1) <> Worksheets("Test").Cells(secondcount + 1, 1) Then
Worksheets("Test").Rows(Count + 1 & ":" & Count + 1).Select
Selection.Insert Shift:=xlDown
With Worksheets("Test")
Worksheets("Test").range(Cells(Count, 1), Cells(Count, 1)).Select
Worksheets("Test").range(Selection, Selection.End(xlToRight)).Select
Worksheets("Test").range(Selection, Selection.End(xlUp)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNon
End With
Count = Count + 1
secondcount = secondcount + 1
End If
Count = Count + 1
secondcount = secondcount + 1
Next
End Sub