deleting cells with a macro.

S

serdar

hi,

i made a macro, simply moves some values to another sheet by checking the
code of the entry.

my problem is when i delete some record and run the macro again currently it
does not refreshes the other sheet. because it only checks a column and
finds a code and then writes the record value to the other sheet.

how should i add a deletion support. any other ways u thinking apart from
worksheet change event?


here is the code:



'-------------some string characters may be in
turkish------------------------------------------



Const TARGETSHEET = "ÝNÞAAT ÝCMAL TABL."

Const MAXLINES = 100
Const WORKSPACE = "A:EM"
Const LCOLCODE = 2
Const RCOLCODE = 12
Const LCOLVALUE = 9
Const RCOLVALUE = 20
Const DOFFSET = 8

Public Sub StartMover()

Dim x, t As Long
Dim pageno As Long



pageno = numerise(ActiveSheet.Name)

If pageno < 1 Then
MsgBox "Çalýþma sayfasýnýn adýna pozitif bir sayý ekleyin."
Exit Sub
End If


'left side
For x = 1 To MAXLINES

If ActiveSheet.Cells(x + DOFFSET, LCOLCODE) <> "" Then


For t = 1 To MAXLINES
If ActiveSheet.Cells(x + DOFFSET + t, LCOLVALUE - 1) = ""
Then
Exit For
End If
Next t

Call MoveItem(ActiveSheet.Cells(x + DOFFSET, LCOLCODE).Value,
ActiveSheet.Cells(x + DOFFSET + t, LCOLVALUE), pageno)


End If

Next x

'right side
For x = 1 To MAXLINES

If ActiveSheet.Cells(x + DOFFSET, RCOLCODE) <> "" Then


For t = 1 To MAXLINES
If ActiveSheet.Cells(x + DOFFSET + t, RCOLVALUE - 1) = ""
Then
Exit For
End If
Next t

Call MoveItem(ActiveSheet.Cells(x + DOFFSET, RCOLCODE).Value,
ActiveSheet.Cells(x + DOFFSET + t, RCOLVALUE), pageno)


End If

Next x




End Sub


Public Sub MoveItem(ByVal code As String, ByVal myValue As Double, ByVal
pageno As Long)

Dim myRange As Range
Dim tRow As Range

Set myRange = Worksheets(TARGETSHEET).Columns(WORKSPACE).Find(code,
LookIn:=xlValues)

If myRange Is Nothing Then
MsgBox "Poz no. bulunamadý."
Exit Sub
End If

Set tRow = Worksheets(TARGETSHEET).Columns("A:A").Find(pageno,
LookIn:=xlValues)

If tRow Is Nothing Then
MsgBox "Ataþman no. bulunamadý."
Exit Sub
End If


Worksheets(TARGETSHEET).Cells(tRow.Row, myRange.Column).Value = myValue


End Sub

Function numerise(inpt As String)
Dim i As Integer
For i = 1 To Len(inpt)
If IsNumeric(Mid(inpt, i, 1)) Then
numerise = numerise & Mid(inpt, i, 1)
End If
Next i
numerise = CLng(numerise)
End Function


'-------------end------------------------------------------
 
Top