View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
K[_2_] K[_2_] is offline
external usenet poster
 
Posts: 557
Default PLEASE ANY BODY CAN CORRECT MY MACRO

I have macro (please see below) which is set on a button in a
spreasheet and it works fine. It basically add 6 rows and then merge
cells of those inserted rows from cell "I" to cell "N" and then sort
out number sequense in 2nd coloumn

Sub InsertLines()
Dim LastRow As Long
Dim StartRow As Long
StartRow = Cells(Rows.Count, 2).End(xlUp).Row - 1
Cells(StartRow + 1, 1).Resize(6, 1).EntireRow.Insert
For i = 1 To 6
Cells(StartRow + i, 9).Resize(1, 6).Merge
Next i
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(StartRow, 2), Cells(LastRow, 2))
..DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
End With
Application.ScreenUpdating = True

End Sub

This macro is set on a button but I want to run it exactly as it works
now from sheet module so to do that what I did is that if cell next to
last value cell in coloumn 2 get value then this macro should run and
do exactly the same job what above macro do. but when i tried it it
all gone funny and everything been blocked. i tried to solve this but
nothing coming up. (please see the macro below which i amended to run
it from sheet module) please if any friend can help and tell me the
correct way to do this. Thanks


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LastRow As Long
Dim StartRow As Long
LLastRow = Cells(Cells.Rows.Count, 2).End(xlUp).Row
If Cells(LLastRow - 1, 1).Offset(0, 1) < "" Then
StartRow = Cells(Rows.Count, 2).End(xlUp).Row - 1
Cells(StartRow + 1, 1).Resize(6, 1).EntireRow.Insert
For i = 1 To 6
Cells(StartRow + i, 9).Resize(1, 6).Merge
Next i
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(StartRow, 2), Cells(LastRow, 2))
..DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
End With
Application.ScreenUpdating = True

End Sub