VBA code to count based on conditions in cells

[gingerbreadgrl]

Hi,

I am looking to automatically generate a unique identification number for each row in my spreadsheet. A few components of the number will be passed into the spreadsheet from another source. But, I need help creating two different parts of the ID. The first is a 3 digit number that will start at the beginning of the year and count up and it will restart at the beginning of the next year. The second is based on how many previous numbers they have, these numbers will be automatically populated into the spreadsheet, and will be separated by semicolons. The code must count how many numbers are in the cell and then add 1. I can't use a formula because for the data to auto-populate the spreadsheet the system must see a blank row. Therefore, I would like the two different numbers to appear in the cell via VBA once a cell has a value to it, particularly a cell in the name column. This is what the spreadsheet currently looks like:

Complete ID	Other Matter IDs	2 digit year	3 digit matter #	C or S	# of Matters	Name
19001C-3	1233456; 234567	19	001	C	3	Jane Doe
19002S-2	345678	19	002	S	2	Sue Smith
19003C-1		19	003	C	1	Jack Johnson
20001S-2	23456	20	001	S	2	Sammy Sosa

<tbody>
</tbody>

The columns in red must auto-populate when a value appears in a name column cell. The columns in blue will flow through from a data source that creates a new row and fills in the information every time there is a new record. The 2 digit year will automatically change to 20 in 2020, that is when the 3 digit number must restart. The # of matters column must count the number of matter IDs in that column and add 1. You will see that if the other matter id's column is blank the # of matters column must take 0 and add 1. This creates the complete ID. If there is a way to put the cell contents together from the last 4 columns into the complete id column automatically that would be great too.

Any thoughts would be much appreciated!

Best,
Gingerbreadgrl

 

[gingerbreadgrl]

It appears that the macro discontinues on the "Exit Sub" in red below because when I push F8 there the yellow highlight stops and the computer makes a noise. I've filled in the data for Other matter IDs, 2 digit year, C or S, and Name columns so there should be everything needed to generate the 3 digit matter # and thus the Complete ID...

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Sub Worksheet_Change(ByVal Target As Range)
    Dim isect As Range
    Dim CompleteID As Range
    Dim OtherMatter As Range
    Dim TwoDigitYear As Range
    Dim ThreeDigitMatter As Range
    Dim cOrS As Range
    Dim NumMatters As Range
    Dim NameCell As Range
    
    Set CompleteID = Range("A2")

[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    Set OtherMatter = FoundCell(CompleteID, "Other Matter IDs")
    Set TwoDigitYear = FoundCell(CompleteID, "2 digit year")
    Set ThreeDigitMatter = FoundCell(CompleteID, "3 digit matter #")
    Set cOrS = FoundCell(CompleteID, "C or S")
    Set NumMatters = FoundCell(CompleteID, "# of Matters")
    Set NameCell = FoundCell(CompleteID, "Name")
    
    If OtherMatter Is Nothing Or TwoDigitYear Is Nothing Or ThreeDigitMatter Is Nothing Or _
       cOrS Is Nothing Or NumMatters Is Nothing Or NameCell Is Nothing Then
    [COLOR=#ff0000]    Exit Sub[/COLOR]
    End If
    
    Set isect = Intersect(Target, Columns(NameCell.Column))
    If Not isect Is Nothing Then
        If GetRange(Target, TwoDigitYear).Value = "" Or _
           GetRange(Target, cOrS).Value = "" Then
            Exit Sub
        End If
        Application.EnableEvents = False
        GetRange(Target, ThreeDigitMatter).Value = Format(Application.WorksheetFunction.CountIf(Columns(TwoDigitYear.Column), _
            "=" & GetRange(Target, TwoDigitYear).Value), "000")
        Dim a As Variant
        a = Split(GetRange(Target, OtherMatter).Value, ";")
        GetRange(Target, NumMatters).Value = UBound(a) + 2
        GetRange(Target, CompleteID).Value = GetRange(Target, TwoDigitYear).Value & _
                                     GetRange(Target, ThreeDigitMatter).Value & _
                                     GetRange(Target, cOrS).Value & "-" & _
                                     GetRange(Target, NumMatters).Value
        Application.EnableEvents = True
    End If
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Function FoundCell(rowStart As Range, searchString As String) As Range
    Dim SearchRange As Range
    Dim LastCell As Range
    Set SearchRange = Range(rowStart, rowStart.End(xlToRight))
    With SearchRange
        Set LastCell = .Cells(.Cells.Count)
        Set FoundCell = .Find(what:=searchString, after:=LastCell)
    End With
End Function[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Function GetRange(t As Range, r As Range) As Range
    Set GetRange = Cells(t.Row, r.Column)
End Function
[/FONT]

 

[shknbk2]

Can you paste some of your data? That might help troubleshoot.

Also, please realize that the CompleteID range (which you have set to A2) should be the header cell that has "Complete ID" in it, not the first cell under the header. Does your header row start in row 2?

 

[gingerbreadgrl]

Oops! The issue was with the header "Complete ID" being in A1 and not A2 (I thought it was supposed to be where the data started). When I used the F9 breakpoint and F8 to step through it, it worked. But, the two zeros are missing from the 3 digit matter #, it showed up as 191C-3... Thanks for your patience!

 

[shknbk2]

We're almost there! Replace the corresponding code with this:

        GetRange(Target, CompleteID).Value = GetRange(Target, TwoDigitYear).Value & _
                                     Format(GetRange(Target, ThreeDigitMatter).Value, "000") & _
                                     GetRange(Target, cOrS).Value & "-" & _
                                     GetRange(Target, NumMatters).Value

 

[gingerbreadgrl]

Yaaaaassss! It worked! Thank you soooooo much for your patience and your help! I hate to ask one more thing but I thought I would just be able to modify the code for a client id, which is simpler than the matter id because all the cells will be filled in. The only number that needs to be generated for the client id is a 4 digit number that changes with the year. I can't get it to work though. Here is what the sheet looks like (I pasted the code into the sheet like last time):

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Client number[/FONT]<strike></strike>	<strike></strike>[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Last name[/FONT]<strike></strike>	<strike></strike>[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]First name[/FONT]<strike></strike>	<strike></strike>[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Original matter ID[/FONT]<strike></strike>	<strike></strike>[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]C1 or C2[/FONT]<strike></strike>	<strike></strike>[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]2-digit year[/FONT]<strike></strike>	<strike></strike>[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]4-digit client number (for the year)[/FONT]<strike></strike>
CL190001	Smith	John	123456	C1	19	00001

<tbody>
</tbody>

<strike></strike>
I modified the code to the following. But when I used the F9 breakpoint and tried to step into it to debug, it won't let me. Here is what I did:

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Sub Worksheet_Change(ByVal Target As Range)[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    Dim isect As Range
    Dim ClientNumber As Range
    Dim OriginalMatter As Range
    Dim TwoDigitYear As Range
    Dim FourDigitClientNumber As Range
    Dim C1OrC2 As Range
    Dim FirstName As Range
    Dim LastName As Range
    
    Set ClientNumber = Range("A1")
    [/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    Set OriginalMatter = FoundCell(ClientNumber, "Original matter ID")
    Set TwoDigitYear = FoundCell(ClientNumber, "2-digit year")
    Set FourDigitClientNumber = FoundCell(ClientNumber, "4-digit client number (for the year)")
    Set C1OrC2 = FoundCell(ClientNumber, "C1 or C2")
    Set FirstName = FoundCell(ClientNumber, "First name")
    Set LastName = FoundCell(ClientNumber, "Last name")
    
    If OriginalMatter Is Nothing Or TwoDigitYear Is Nothing Or FourDigitClientNumber Is Nothing Or _
       C1OrC2 Is Nothing Or FirstName Is Nothing Or LastName Is Nothing Then
        Exit Sub
    End If
    
       Set isect = Intersect(Target, Columns(LastName.Column))
    If Not isect Is Nothing Then
        If GetRange(Target, TwoDigitYear).Value = "" Or _
           GetRange(Target, C1OrC2).Value = "" Then
            Exit Sub
        End If
        Application.EnableEvents = False
        GetRange(Target, FourDigitClientNumber).Value = Format(Application.WorksheetFunction.CountIf(Columns(TwoDigitYear.Column), _
            "=" & GetRange(Target, TwoDigitYear).Value), "0000")
        GetRange(Target, ClientNumber).Value = "CL" & GetRange(Target, TwoDigitYear).Value & _
                                     Format(GetRange(Target, FourDigitClientNumber).Value, "0000")
        Application.EnableEvents = True
    End If[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]End Sub
Function FoundCell(rowStart As Range, searchString As String) As Range
    Dim SearchRange As Range
    Dim LastCell As Range
    Set SearchRange = Range(rowStart, rowStart.End(xlToRight))
    With SearchRange
        Set LastCell = .Cells(.Cells.Count)
        Set FoundCell = .Find(what:=searchString, after:=LastCell)
    End With
End Function[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Function GetRange(t As Range, r As Range) As Range
    Set GetRange = Cells(t.Row, r.Column)
End Function[/FONT]

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif][/FONT]

 

[shknbk2]

In my testing, your code worked perfectly. Great job!. I'm not sure where you are having problems.

One thing that helped was for me in my test range to set the formatting of the 4-Digit column to Text. When it was General, a single digit showed, but changing it to Text showed the leading 3 zeroes as well.

In order to debug the code using the breakpoint, change the value of a cell on the worksheet, and the code should stop on the breakpoint. If you want to step through the code without changing anything on the worksheet, you'll have to use something like the code below, which you can paste at the end of the code you have. This will call the "Change" event and pass in any range you want to test.

Sub test_Worksheet_Change()
    Worksheet_Change Range("B2")
End Sub

The reason why you can't simply put the cursor in the Worksheet_Change code and start debugging is because it has a variable (Target) that must get passed in.

 

[gingerbreadgrl]

Awesome!! That worked! The code didn't want to run on its own, but when I pasted your code at the bottom and stepped through it once it started working! Not sure why it needed the step through to work but at least it did the trick. This is really fantastic. I'm so grateful, and I learned a ton! You are the best!

Thank you!
Gingerbreadgrl