Help with code issues

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
 
C

Corey

Does this SORT the sheet :
Application.Run ("'Hazmat Iventory Sheet2.xls'!Mod_Sort")


If so can you not add it to the Delete code ?
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)
Application.Run ("'Hazmat Iventory Sheet2.xls'!Mod_Sort")
Exit Sub

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
 
M

Mekinnik

Corey,
Thanks for responding to my post but I think I am trying to hard, I am
going to get rid of the auto numbering portion of the code and that will fix
everything.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top