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:

[TABLE="width: 800"]
<tbody>[TR]
[TD]Complete ID[/TD]
[TD]Other Matter IDs[/TD]
[TD]2 digit year[/TD]
[TD]3 digit matter #[/TD]
[TD]C or S[/TD]
[TD]# of Matters[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]19001C-3[/TD]
[TD]1233456; 234567[/TD]
[TD]19[/TD]
[TD]001[/TD]
[TD]C[/TD]
[TD]3[/TD]
[TD]Jane Doe[/TD]
[/TR]
[TR]
[TD]19002S-2[/TD]
[TD]345678[/TD]
[TD]19[/TD]
[TD]002[/TD]
[TD]S[/TD]
[TD]2[/TD]
[TD]Sue Smith[/TD]
[/TR]
[TR]
[TD]19003C-1[/TD]
[TD][/TD]
[TD]19[/TD]
[TD]003[/TD]
[TD]C[/TD]
[TD]1[/TD]
[TD]Jack Johnson[/TD]
[/TR]
[TR]
[TD]20001S-2[/TD]
[TD]23456[/TD]
[TD]20[/TD]
[TD]001[/TD]
[TD]S[/TD]
[TD]2[/TD]
[TD]Sammy Sosa[/TD]
[/TR]
</tbody>[/TABLE]

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

 

[shknbk2]

Here's what I came up with based on your data. This would go in the Sheet1 module.

I'm not sure if your data always starts in A1, but just in case, you can change the CompleteID assignment to another cell, and it will go from there.

Dim TargetRange As Range

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 TargetRange = Target
   [COLOR=#ff0000] Set CompleteID = Range("A1")[/COLOR]
    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
        Exit Sub
    End If
    
    Set isect = Intersect(Target, Columns(NameCell.Column))
    If Not isect Is Nothing Then
        If GetRange(TwoDigitYear).Value = "" Or _
           GetRange(cOrS).Value = "" Then
            Exit Sub
        End If
        Application.EnableEvents = False
        GetRange(ThreeDigitMatter).Value = Format(Application.WorksheetFunction.CountIf(Columns(TwoDigitYear.Column), _
            "=" & GetRange(TwoDigitYear).Value), "000")
        Dim a As Variant
        a = Split(GetRange(OtherMatter).Value, ";")
        GetRange(NumMatters).Value = UBound(a) + 2
        GetRange(CompleteID).Value = GetRange(TwoDigitYear).Value & _
                                     GetRange(ThreeDigitMatter).Value & _
                                     GetRange(cOrS).Value & "-" & _
                                     GetRange(NumMatters).Value
        Application.EnableEvents = True
    End If
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

Function GetRange(r As Range) As Range
    Set GetRange = Cells(TargetRange.Row, r.Column)
End Function

 

[gingerbreadgrl]

Hi Shknbk2,

Thanks so much for considering my request and responding. When I try to run the macro it gives me a "compile error: Expected End Sub" then it places a blue bar right underneath the first line "Dim TargetRange As Range." I tried putting an end sub after the very last end function but it still produced the error. Also, I don't know how to put the macro into a specific sheet. There are two sheets in this workbook, this one is titled "Matter ID" could we just declare it in the macro?

Thanks!!
Gingerbreadgrl

 

[shknbk2]

This code would go in the macro for the Matter ID sheet. Right-click the tab for the Matter ID worksheet in the regular Excel view and select "View Code". It seems like you might already have some code there if you are getting the error you described. You can put this code at the very beginning so that the first Dim TargetRange is at the top. If the code already has a Sub Worksheet_Change block, there may be more we have to do.

 

[gingerbreadgrl]

Hi,

So I right clicked on the sheet and put the code in there. Not sure where it was before, but there isn't any other code in there. When I pasted the code in there it has a line after the "End sub," there is also a line after the "End Function" and the last part has the two "End Functions" at the end. I tried putting an end sub at the end to see if that would change the error, but it didn't. I'm not sure what is causing it.

 

[shknbk2]

Ok. Try this instead. It gets rid of the global variable at the start of the code.

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("A1")

    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
        Exit Sub
    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

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

Function GetRange(t As Range, r As Range) As Range
    Set GetRange = Cells(t.Row, r.Column)
End Function

 

[gingerbreadgrl]

Hi Shknbk2,

So it may just be me naming this thing wrong. I was adding a macro name in front of the first line of code. But, is the "Private Sub Worksheet_Change(ByVal Target As Range)" the name of the macro? When I don't put a macro name at the top and start with your first code line instead it pops up with a box to name the macro. When I change that line it creates an error on the line of code that contains the target "[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]If GetRange(Target, TwoDigitYear).Value = "" Or _" based on my limited knowledge that is because the target is declared in the first line so you can't mess with it.

I guess my question is should I be adding a name "Sub CreateMatterID()" before your first line of code? That is what appears to be causing the "expected end sub" error.

Thanks for your time!
Gingerbreadgrl
[/FONT]

 

[shknbk2]

My code should be the only thing in the Matter ID code module. Delete everything that is there and paste all of my code (the Sub and 2 Functions). You shouldn't need to add anything. The Worksheet_Change procedure is needed to automatically run the code when the Matter ID sheet changes.

After you paste, click Debug->Compile VBAProject. Do any errors show up or does it not appear to do anything (which means that it all compiled fine)?

 

[gingerbreadgrl]

Okay when I click combile VBA Project nothing happens. When I hit play, a pop up box appears that has a Macro Name at the top, the box is completely empty, and there is a run button but it is greyed out, the only button available in the pop up is cancel. If I click save and exit out of VBA to put a test sample in the spreadsheet nothing happens either. I'm not sure but it seems like it is not recognizing the first line as the name of the macro? I checked that the code is in there by right clicking on the sheet name and it is...

 

[shknbk2]

Sounds good, so far. Now, in the code, put the cursor on the line with Set CompleteID = Range("A1") and hit F9. The line with change to a maroon color and set a break point. Now, back in the spreadsheet, change the value of any cell. The code processing will pause (with yellow line) on the Set CompleteID line, and you can continue line by line by hitting F8. This will allow you to see what is going on.

Essentially, nothing should happen on the sheet unless the "Name" column has a value changed in it and also that the "2 digit year" and "C or S" columns on that same row have data. If not, nothing should change because a full ID can't be calculated.