Lets try again code help

[Guest]

this is my current code for my button click event, I have a number of things
I want to happen when the button is clicked and one protion is giving me
trouble. The part that creates the MSDS#. I want the value of CboDept (a list
of up to 3 letters) to be converted to an alphanumeric number (i.e. xx001)
and store it into a string so I can call it at the end of the code to be
inserted into sheet "Lists" column 'M'. Everytime the button click event
fires I want the code to search column 'M' for the left 2 or 3 letters that
match the CboDept selection and then add onto it the next sequencial number
starting at 001 and so on. If it doesn't find a match then it will just add
it to the column.
#1) I cannot seem to get the 001 at the end of the 2 letters I just get a 1
and it won't add to the count.
#2) I am unable to get it to work in conjuction with the current code
#3) I do believe I am going about it all wrong, please help to steer me in
the right direction

Private Sub BtnAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim dept As String
Dim c As Range

Set ws = Worksheets("ProCode")
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'creates the MSDS#
dept = Me.CboDept.Value & "0" + 1
For Each c In Worksheets("Lists").Range("M2:M1000")
If c.Value <> dept Then
c.Value = dept
End If
If c.Value = dept Then
MsgBox "number matched"
Exit Sub
End If
Next c

'check for the product name
If Trim(Me.TxtProd.Value) = "" Then
Me.TxtProd.SetFocus
MsgBox "Please enter the product name"
Exit Sub
End If

'copy the data to the database
Application.EnableEvents = False
ws.Cells(iRow, 2).Value = Me.TxtProd.Value
ws.Cells(iRow, 3).Value = IIf(Me.CkBox1.Value, "Yes", "No")
ws.Cells(iRow, 4).Value = IIf(Me.CkBox2.Value, "Yes", "No")
ws.Cells(iRow, 5).Value = IIf(Me.CkBox3.Value, "Yes", "No")
ws.Cells(iRow, 6).Value = Me.CboFire.Value
ws.Cells(iRow, 7).Value = Me.CboHealth.Value
ws.Cells(iRow, 8).Value = Me.CboReact.Value
ws.Cells(iRow, 9).Value = Me.CboSpec.Value
ws.Cells(iRow, 10).Value = Me.CboDisp.Value
ws.Cells(iRow, 11).Value = Me.TxtQuan.Value
ws.Cells(iRow, 12).Value = Me.TxtDate.Value
ws.Cells(iRow, 13).Value = dept
Application.EnableEvents = True

'the sort will fire with this line.
ws.Cells(iRow, 1).Value = Me.CboMan.Value
FrmProduct.CboMan.Value = Me.CboMan.Value

'clear the data
Me.CboMan.Value = ""
Me.TxtProd.Value = ""
Me.CkBox1.Value = False
Me.CkBox2.Value = False
Me.CkBox3.Value = False
Me.CboFire.Value = ""
Me.CboHealth.Value = ""
Me.CboReact.Value = ""
Me.CboSpec.Value = ""
Me.CboDisp.Value = ""
Me.TxtQuan.Value = ""
Me.TxtDate.Value = ""
End Sub

 

[Guest]

hi
I think this is the line that is giving you your problem....
dept = Me.CboDept.Value & "0" + 1
you are trying to combine 2 letters in me.cbodept with 3 numbers ie total 5
characters
correct me if i am wrong.
mathmaticly, leading zeros on not needed. this is why xl gets rid of them.
to have leading zeros, the number has to be formated as text. this create
another problem in that you can add text.
so lets play a game.
dim dept as string
dim n as long
Set srng = Worksheets("Lists").Range("M2:M1000")
set dept = Me.CboDept.Value
n = 1
For Each c In srng
If Len(dept & "00" & n) = 5 Then
c.Value = dept & "00" & n 'xx001 to xx009
Else
If Len(dept & "0" & n) = 5 Then
c.Value = dept & "0" & n ' xx010 to xx099
Else
If Len(dept & n) = 5 Then
c.Value = dept & n 'xx100 to xx999
End If
End If
End If
n = n + 1
Next
this will get to 999. if you need more then add more if statements.(and
characters)
adjust code to fit your data. this worked in xp for my test up to 999.

post back if you have question/problems

Regards
FSt1

 

[Steve Yandl]

Here is an approach you can try. I'm assuming that CboDept is the name of a
combobox or textbox where you're entering the two or three letter grouping
that signifies the department. This sub will scan column M:M on worksheet
"Lists" to locate the top existing entry (if there is one) and enter the
next highest entry at the bottom of M:M.

____________________________________

Dim intMtoprow As Integer
Dim dept As String
Dim Y As Integer
Dim X As Integer

intMtoprow = Worksheets("Lists").Range("M65536").End(xlUp).Row
dept = Me.CboDept.Text
Y = 0

For R = 1 To intMtoprow
strCell = Worksheets("Lists").Cells(R, 13).Value
If InStr(strCell, dept) = 1 Then
X = CInt(Mid(strCell, Len(dept) + 1))
If X > Y Then
Y = X
End If
End If
Next R

Worksheets("Lists").Cells(intMtoprow + 1, 13).Value = dept & Format(Y + 1,
"00#")

End Sub

_____________________________________

Steve

 

[Dave Peterson]

I didn't take the time to set up a userform with all those controls, but this
kind of thing worked for me.

Option Explicit
Function UseThisOne(myStr As String, RngToCheck As Range) As Long

Dim iCtr As Long
Dim res As Variant

UseThisOne = -999
For iCtr = 1 To 999
res = Application.Match(myStr & Format(iCtr, "000"), RngToCheck, 0)
If IsError(res) Then
Exit For
Else
UseThisOne = iCtr
End If
Next iCtr

If UseThisOne = -999 Then
'it wasn't found
UseThisOne = 1
Else
UseThisOne = UseThisOne + 1
End If

End Function
'and just to show that it works...
Sub testme()

Dim ws As Worksheet
Dim RngToCheck As Range
Dim DestCell As Range
Dim NextOneToUse As Long
Dim myStr As String

myStr = "MS" 'my version of your me.cbodept.value

Set ws = Worksheets("procode")
With ws
Set RngToCheck = .Range("m1", .Cells(.Rows.Count, "M").End(xlUp))
Set DestCell = .Cells(.Rows.Count, "M").End(xlUp).Offset(1, 0)
End With
NextOneToUse = UseThisOne(myStr, RngToCheck)
DestCell.Value = myStr & Format(NextOneToUse, "000")

'your code may look like
'NextOneToUse = UseThisOne(me.cbodept.value, RngToCheck)
'DestCell.Value = me.cbodept.value & Format(NextOneToUse, "000")

End Sub

 

[Steve Yandl]

Note: The line
Worksheets("Lists").Cells(intMtoprow + 1, 13).Value = dept & Format(Y + 1,
"00#")
should all be on a single line in your subroutine.

Steve

 

[Dave Peterson]

I was gonna add some validation checks, but then decided not to.

This function should work ok, too:

Option Explicit
Function UseThisOne(myStr As String, RngToCheck As Range) As Long

Dim iCtr As Long
Dim res As Variant

UseThisOne = 0
For iCtr = 1 To 999
res = Application.Match(myStr & Format(iCtr, "000"), RngToCheck, 0)
If IsError(res) Then
Exit For
Else
UseThisOne = iCtr
End If
Next iCtr

UseThisOne = UseThisOne + 1

End Function

 

[Steve Yandl]

On giving it some more thought, there is an error condition I didn't
consider when writing the original sub. Suppose you already have values
xyz001, xyz002, xyz003 and then instead of entering xyz, you simpy entered
xy. Ideally, this would generate xy001 but since there are already matches
for xy, the sub will try to treat z003 as a number and generate an error.

The corrected version below should handle that. I also changed things so
the final result is assigning an appropriate alpha numeric value to your
variable dept rather than insert the value at the bottom of column M. I
think the code below should integrate easily with your existing code.

_______________________________________

Dim intMMtop As Integer
Dim dept As String
Dim Y As Integer
Dim X As Integer

intMMtop = Worksheets("Lists").Range("M65536").End(xlUp).Row
dept = Me.CboDept.Text
Y = 0

For R = 1 To intMMtop
strCell = Worksheets("Lists").Cells(R, 13).Value
If InStr(strCell, dept) = 1 And _
IsNumeric(Mid(strCell, Len(dept) + 1)) Then
X = CInt(Mid(strCell, Len(dept) + 1))
If X > Y Then
Y = X
End If
End If
Next R

dept = dept & Format(Y + 1, "00#")
_______________________________________

Steve

 

[Guest]

Well, I tried your code and it works only partly. When you add the first
entry it will assign the number XX001, however when you go to inset the
second one it will not assign a number at all. The way I am trying to make it
work is the number as I call it will be a 2 letter alphanumeric text with a 3
digit number counter at the end starting with number 000 and counting up. I
am trying to get it to compare what is selected in the combobox 'CboDept'
with the first 2 letters of the data in column 'M' of the sheet named
'ProCode' and either add 1 number to what matches 'CboDept' or create a new
number starting back at 000 with the new 2 letters selected and then apply it
to the added data when the add button is clicked.

 

[Steve Yandl]

In the two locations where I used Worksheets("Lists"), edit to
Worksheets("Procode") and it should work fine. Reading your initial
question, I made the incorrect assumption that the column M where the MSDS#s
were place was on the "Lists" sheet.

Steve

 

[Guest]

I did make thoughs changes, however it is putting the number in the first row
of column 'M' only which happens to be my heading row and if I try to add
another it will not update it at all?

 

[Steve Yandl]

Change
For R = 1 To intMMtop
to
For R = 2 To intMMtop

Steve

 

[Guest]

I tried that also without any luck, so I thought if you saw the add button
code maybe it would help. I would gladly accept any changes you think would
be needed to make this work or if I have been unclear on explaining what it
is I am trying to do, please let me know and I will try to clear it up the
best I can. Thank you very much for all you help in correcting this problem.

Private Sub BtnAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim intMtoprow As Integer
Dim dept As String
Dim x As Integer
Dim y As Integer

dept = Me.CboDept.Text
y = 0
Set ws = Worksheets("ProCode")
'find first empty row in database
intMtoprow = ws.Range("M1000").End(xlUp).Row
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for the product name
If Trim(Me.TxtProd.Value) = "" Then
Me.TxtProd.SetFocus
MsgBox "Please enter the product name"
Exit Sub
End If

'creates the MSDS#
For r = 2 To intMtoprow
strCell = ws.Cells(r, 13).Value
If InStr(strCell, dept) = 1 And _
IsNumeric(Mid(strCell, Len(dept) + 1)) Then
x = CInt(Mid(strCell, Len(dept) + 1))
y = x
End If
Next r

'copy the data to the database
Application.EnableEvents = False
ws.Cells(iRow, 2).Value = Me.TxtProd.Value
ws.Cells(iRow, 3).Value = IIf(Me.CkBox1.Value, "Yes", "No")
ws.Cells(iRow, 4).Value = IIf(Me.CkBox2.Value, "Yes", "No")
ws.Cells(iRow, 5).Value = IIf(Me.CkBox3.Value, "Yes", "No")
ws.Cells(iRow, 6).Value = Me.CboFire.Value
ws.Cells(iRow, 7).Value = Me.CboHealth.Value
ws.Cells(iRow, 8).Value = Me.CboReact.Value
ws.Cells(iRow, 9).Value = Me.CboSpec.Value
ws.Cells(iRow, 10).Value = Me.CboDisp.Value
ws.Cells(iRow, 11).Value = Me.TxtQuan.Value
ws.Cells(iRow, 12).Value = Me.TxtDate.Value
ws.Cells(iRow, 13).Value = dept & Format(y + 1, "00#")

Application.EnableEvents = True

'the sort will fire with this line.
ws.Cells(iRow, 1).Value = Me.CboMan.Value
FrmProduct.CboMan.Value = Me.CboMan.Value

'clear the data
Me.CboMan.Value = ""
Me.TxtProd.Value = ""
Me.CkBox1.Value = False
Me.CkBox2.Value = False
Me.CkBox3.Value = False
Me.CboFire.Value = ""
Me.CboHealth.Value = ""
Me.CboReact.Value = ""
Me.CboSpec.Value = ""
Me.CboDisp.Value = ""
Me.TxtQuan.Value = ""
Me.TxtDate.Value = ""
End Sub

 

[Steve Yandl]

I see the error but I'm watching a ball game and answering during time outs.
I'll get back to you later this evening with an amended sub. You're missing
an If....End If loop for sure that breaks the logic.

Steve

 

[Steve Yandl]

I think you just left out two lines from my code. Copy and paste to update
your section creating the MSDS# from below

__________________________________

'creates the MSDS#
For R = 1 To intMtoprow
strCell = ws.Cells(R, 13).Value
If InStr(strCell, dept) = 1 And _
IsNumeric(Mid(strCell, Len(dept) + 1)) Then
X = CInt(Mid(strCell, Len(dept) + 1))
If X > Y Then
Y = X
End If
End If
Next R

_________________________________

Steve

 

[Guest]

Steve,
I would like to thank you for all your help, I still have more issues I am
dealing with however I try to limit them to one a day. I will post it
tomorrow or Monday.

Thanks again