User Form VBA Code - Incremental auto numbering and directory creation

jkey07

New Member
Joined
Sep 25, 2013
Messages
23
Hi,

Bit of a newbie to vba but attempting to scramble my way through by reading, grabbing and modifying other peoples code in order to bodge together something that might prove useful to me.

Basically, I'm trying to do two things at this point which seem to be complettely alluding me altogether and have spent countless hours trying to make work but just don't have the knowledge - I would like to create some sort of auto numbering routine on a Userform I have created and at the end I would like that User Form code to create a directory according to the User Form number.

The User Form

The User form is something I have created to control a set of input variables into a set spreadsheet, namely giving details of engine faults.


Auto Numbering routine

The code below details the routines I've input into the User form. For the readers reference:

User Form Name: IssueLog
Worksheet Name: Issue_Log
Text box in User Form for Numbering (Label Name): IssueNo

My intention is for the routine to the last row of data input into the speadsheet, to read the associated number from a specific column (which will begin with the Designation REI...follwed by the number, i.e. REI1, REI2, REI3, etc), to increment that number by one and then to present that in a text box on the userform I have created for it to be input into the spreadhseet later on by further code.

I currently have no error but the code just fails to work, here it is:

Code:
Private Sub IssueLog_Initialize()
Dim iRow As Long
Dim ws As Worksheet
    Set ws = Worksheets("Issue_Log")
    
    IssueNo.Enabled = True
    'find last data row from database
    iRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
 
    If ws.Range("B" & iRow).Value = "" Then
        IssueNo.Text = "REI1"
        ws.Range("B" & iRow).Value = IssueNo
    Else
        IssueNo.Text = "REI" & Val(Mid(ws.Cells(iRow, 1).Value, 4)) + 1
        ws.Range("B" & iRow + 1).Value = IssueNo
    End If
 
End Sub

Creating a directory

When the relevant number has been assigned I would like to use this number within the associated text box on the user form to create a directory within under a pre created sub directory using a particular path, for example I would like the code to create a directory called REI1 under the path c:\Engine Faults\Issue_Log.

Because my auto numbering code doesn't appear to work I currently put this in manually but the code I have for that does not work anyway.

The code I have is as follows:

Code:
'Creates relevant directory for new isue log
Dim NewFolder   As String
NewFolder = IssueNo.Text
'If Len(Dir("c:\jkey\"(NewFolder), vbDirectory)) = 0 Then
ChDir "c:\jkey\Excel"
   MkDir (NewFolder)

This code is posted after the following initialising routine, with much other code (used for checking, entering and clearing data into the spreadsheet):

Code:
Private Sub cmdEnter_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Issue_Log")

And so the whole section of code intended for checking, inputing and clearing data looks as follows:

Code:
'*********************************** SECTION 1 - INITIALISES THE MACRO FOR DATA ENTRY 'INSERT DATA BUTTON' *****
Private Sub cmdEnter_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Issue_Log")
'*********************************** SECTION 2 - FINDS THE NEXT AVAILABLE ROW FOR DATA ENTRY *******************
'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'*********************************** SECTION 3 - CHECKS FOR ENTERED DEAILS *************************************
'check for Date Status
If Trim(Me.tbDate.Value) = "" Then
Me.tbDate.SetFocus
MsgBox "Please Enter a Date"
Exit Sub
End If
'check for Description Status
If Trim(Me.tbDescription.Value) = "" Then
Me.tbDescription.SetFocus
MsgBox "Please Enter a Description"
Exit Sub
End If
'check for Raised By Status
If Trim(Me.cboRaisedBy.Value) = "SELECT" Then
Me.cboRaisedBy.SetFocus
MsgBox "Please Select a Raised Name"
Exit Sub
End If
'check for Assigned To Status
If Trim(Me.cboAssignedTo.Value) = "SELECT" Then
Me.cboAssignedTo.SetFocus
MsgBox "Please Select an Assigned Name"
Exit Sub
End If
'check for Critical Level Status
If Trim(Me.cboCritLevel.Value) = "SELECT" Then
Me.cboCritLevel.SetFocus
MsgBox "Please Select a Critical Level"
Exit Sub
End If
'check for Platform Status
If Trim(Me.cboPlatform.Value) = "SELECT" Then
Me.cboPlatform.SetFocus
MsgBox "Please Select a Platform"
Exit Sub
End If
'check for Train Code Status
If Trim(Me.cboTrainCode.Value) = "SELECT" Then
Me.cboTrainCode.SetFocus
MsgBox "Please Select a Train Code"
Exit Sub
End If
'check for OEM Name Status
If Trim(Me.cboOEMName.Value) = "SELECT" Then
Me.cboOEMName.SetFocus
MsgBox "Please Select an OEM Designation"
Exit Sub
End If
'check for Major System Status
If Trim(Me.cboMajorSys.Value) = "SELECT" Then
Me.cboMajorSys.SetFocus
MsgBox "Please Select a Major System"
Exit Sub
End If
'check for Minor System Status
If Trim(Me.cboMinorSys.Value) = "SELECT" Then
Me.cboMinorSys.SetFocus
MsgBox "Please Select an Minor Systeme"
Exit Sub
End If
'check for Additional Details Status
If Trim(Me.tbDetails.Value) = "" Then
Me.tbDetails.SetFocus
MsgBox "Please Enter a comment in Additional Details"
Exit Sub
End If
'********************************** SECTION 3 - ENTERS THE INPUT DATA INTO THE ASSIGNED DATABASE *****************
'copy the data to the database
ws.Cells(iRow, 2).Value = Me.IssueNo.Value
ws.Cells(iRow, 3).Value = Me.cboCritLevel.Value
ws.Cells(iRow, 4).Value = Me.cboPlan.Value
ws.Cells(iRow, 5).Value = Me.tbDescription.Value
ws.Cells(iRow, 6).Value = Me.tbDate.Value
ws.Cells(iRow, 7).Value = Me.cboRaisedBy.Value
ws.Cells(iRow, 8).Value = Me.cboAssignedTo.Value
ws.Cells(iRow, 9).Value = Me.cboPlatform.Value
ws.Cells(iRow, 10).Value = Me.cboTrainCode.Value
ws.Cells(iRow, 11).Value = Me.cboTrainSec.Value
ws.Cells(iRow, 12).Value = Me.cboOEMName.Value
ws.Cells(iRow, 13).Value = Me.cboMajorSys.Value
ws.Cells(iRow, 14).Value = Me.cboMinorSys.Value
ws.Cells(iRow, 15).Value = Me.tbDetails.Value
'*********************************** SECTION 4 - CREATES NEW DIRECTORY FOR INDIVIDUAL ISSUE **********************
'Creates relevant directory for new isue log
Dim NewFolder   As String
NewFolder = IssueNo.Text
'If Len(Dir("c:\jkey\"(NewFolder), vbDirectory)) = 0 Then
ChDir "c:\jkey\Excel"
   MkDir (NewFolder)
'************************************ SECTION 5 - ACKNOWLEDGES THAT DATA HAS BEEN INPUT CORRECTLY *****************
'Message box to say that the input data has been added
MsgBox "Data added", vbOKOnly + vbInformation, "Data Added"
'************************************ SECTION 6 - CLEARS THE DATA BOXES READY FOR THE NEXT ENTRY ******************
'clear the data
Me.IssueNo.Value = ""
Me.cboCritLevel.Value = "SELECT"
Me.cboPlan.Value = "SELECT"
Me.tbDescription.Value = ""
Me.tbDate.Value = ""
Me.cboRaisedBy.Value = "SELECT"
Me.cboAssignedTo.Value = "SELECT"
Me.cboPlatform.Value = "SELECT"
Me.cboTrainCode.Value = "*ENTER PLATFORM*"
Me.cboTrainSec.Value = "SELECT"
Me.cboOEMName.Value = "*ENTER TRAIN CODE*"
Me.cboMajorSys.Value = "*ENTER TRAIN SECTION*"
Me.cboMinorSys.Value = "*ENTER TRAIN SECTION*"
Me.tbDetails.Value = ""
Me.tbDate.SetFocus

'*********************************** SECTION 6 - ENDS THE MACRO ***************************************************
End Sub

Not one to give in I'm stumped and so I run for help...Undoubtedly, I'm commiting some sort of vba cardinal sin but here is where my knowledge ends.

I'd really appreciate it if someone could lend a hand. Apologies for the long thread and potential inadvertent errors in thread posting.

Cheers

jkey07
 
Right having posted that only 2 minutes ago I think I may have fixed the directory creation...I removed the paranthesis around NewFolder, not sure why they were there in the first place. But the auto incremental numbering remains an issue.
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top