M
Mekinnik
I am using Excel 2007 I have a userform with 3 buttons on it one for closing
the form one for adding info and one for deleting info. The problem is that I
have a worksheet change event that sorts the information, which with the add
button works fine, however when you delete a row it will not sort and
renumber the information, here is my code from the worksheet and buttons, I
would like some help in removing the worksheets change event and adding it to
the add button and also adding it to the delete button so that when it finds
the value in column b it will not only sort the worksheet it will also
renumber column a.
Private Sub BtnAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim res As Variant
Set ws = Worksheets("MANCODE")
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
..End(xlUp).Offset(1, 0).Row
'check for the manufacturer name
If Trim(Me.TxtMan.Value) = "" Then
Me.TxtMan.SetFocus
MsgBox "Please enter the Manufacturer's name"
Exit Sub
End If
'find and copy state abbreviation to row 5
With Worksheets("Lists")
res = Application.VLookup(Me.CmbSt.Value, _
Worksheets("Lists").Range("A:B"), 2, False)
If IsError(res) Then
Else
ws.Cells(iRow, 5).Value = (res)
End If
End With
'copy the data to the database
Application.EnableEvents = False
ws.Cells(iRow, 3).Value = Me.TxtAdd.Value
ws.Cells(iRow, 4).Value = Me.TxtCity.Value
ws.Cells(iRow, 6).Value = Me.TxtZip.Value
ws.Cells(iRow, 7).Value = Me.TxtPhn.Value
'the sort will fire with this line.
ws.Cells(iRow, 2).Value = Me.TxtMan.Value
Application.Run ("'Hazmat Iventory Sheet2.xls'!Mod_Sort")
Application.EnableEvents = True
ws_exit:
Application.EnableEvents = True
'clear the data
Me.TxtMan.Value = ""
Me.TxtAdd.Value = ""
Me.TxtCity.Value = ""
Me.CmbSt.Value = ""
Me.TxtZip.Value = ""
Me.TxtPhn.Value = ""
End Sub
Private Sub BtnClose_Click()
FrmManu.Hide
StrtUpFrm.Show
End Sub
Private Sub BtnDelete_Click()
Dim fRow As Long
Application.EnableEvents = False
On Error GoTo ender
fRow = Columns(2).Find(What:=TxtMan.Value, _
After:=Cells(5000, 2), LookIn:=xlFormulas, _
LookAT:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Row
Rows(fRow).Delete
Application.Run (Msort)
Exit Sub
ender:
MsgBox "Value not found"
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B2:B5001"
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Me.Cells(.Row, "A").Value = WorksheetFunction.Max(Range("A1:A5001")) + 1
Me.Range("A:G").Sort key1:=Me.Range("B3"), header:=xlYes
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
the form one for adding info and one for deleting info. The problem is that I
have a worksheet change event that sorts the information, which with the add
button works fine, however when you delete a row it will not sort and
renumber the information, here is my code from the worksheet and buttons, I
would like some help in removing the worksheets change event and adding it to
the add button and also adding it to the delete button so that when it finds
the value in column b it will not only sort the worksheet it will also
renumber column a.
Private Sub BtnAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim res As Variant
Set ws = Worksheets("MANCODE")
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
..End(xlUp).Offset(1, 0).Row
'check for the manufacturer name
If Trim(Me.TxtMan.Value) = "" Then
Me.TxtMan.SetFocus
MsgBox "Please enter the Manufacturer's name"
Exit Sub
End If
'find and copy state abbreviation to row 5
With Worksheets("Lists")
res = Application.VLookup(Me.CmbSt.Value, _
Worksheets("Lists").Range("A:B"), 2, False)
If IsError(res) Then
Else
ws.Cells(iRow, 5).Value = (res)
End If
End With
'copy the data to the database
Application.EnableEvents = False
ws.Cells(iRow, 3).Value = Me.TxtAdd.Value
ws.Cells(iRow, 4).Value = Me.TxtCity.Value
ws.Cells(iRow, 6).Value = Me.TxtZip.Value
ws.Cells(iRow, 7).Value = Me.TxtPhn.Value
'the sort will fire with this line.
ws.Cells(iRow, 2).Value = Me.TxtMan.Value
Application.Run ("'Hazmat Iventory Sheet2.xls'!Mod_Sort")
Application.EnableEvents = True
ws_exit:
Application.EnableEvents = True
'clear the data
Me.TxtMan.Value = ""
Me.TxtAdd.Value = ""
Me.TxtCity.Value = ""
Me.CmbSt.Value = ""
Me.TxtZip.Value = ""
Me.TxtPhn.Value = ""
End Sub
Private Sub BtnClose_Click()
FrmManu.Hide
StrtUpFrm.Show
End Sub
Private Sub BtnDelete_Click()
Dim fRow As Long
Application.EnableEvents = False
On Error GoTo ender
fRow = Columns(2).Find(What:=TxtMan.Value, _
After:=Cells(5000, 2), LookIn:=xlFormulas, _
LookAT:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Row
Rows(fRow).Delete
Application.Run (Msort)
Exit Sub
ender:
MsgBox "Value not found"
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B2:B5001"
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Me.Cells(.Row, "A").Value = WorksheetFunction.Max(Range("A1:A5001")) + 1
Me.Range("A:G").Sort key1:=Me.Range("B3"), header:=xlYes
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub