How to Increment a Alphanumeric String on Number of occurrences in Column

USFengBULLS · Jan 25, 2019

Hello All,

I have this code very close to what I need it to do but I think I need to add a counter of some sort. I'll try to explain this AS BEST AS POSSIBLE.
I need this code to count how many times there is an occurrence of an Alphanumeric value in Column C and then simply increment the number up + 1. Take a look at the data below:

01	CASEWORK	LEVEL 1/ AREA A/ RM 124
01	CASEWORK	LEVEL 1/ AREA A/ RM 125
01	CASEWORK	LEVEL 1/ AREA A/ RM 126
01	CASEWORK	LEVEL 1/ AREA A/ RM 133
01	CASEWORK	LEVEL 1/ AREA A/ RM 134

02	WALL PANELS	LEVEL 1/ AREA A/ RM 125
02	WALL PANELS	LEVEL 1/ AREA A/ RM 133
02	WALL PANELS	LEVEL 1/ AREA A/ RM 134

If the user in column K (Not Shown here, These are column A, B, C) selects REVISE/AND RESUBMIT from a in cell Drop down it runs this code:

Public Sub REVISED(trow As Double)

Dim erow As Double
Dim Dn As Range
Dim Rng As Range

'Copy Cells down to next Blank Row
erow = Sheets("DRAWING SCHEDULE").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Range(Cells(trow, 1), Cells(trow, 3)).Copy Sheets("DRAWING SCHEDULE").Cells(erow, 1)

'Renames deplicate to REV #
Set Rng = Range(Range("A11"), Range("A" & Rows.Count).End(xlUp))
For Each Dn In Rng
If Dn.Row = Rng(Rng.Count).Row Then
Dn.Offset(, 2).Value = Dn.Offset(, 2).Value & "/ REV " & Rng.Count - 2

End If
Next Dn

End Sub

It makes the copy down to the next blank row and adds "/ REV" just fine but it is the number value I cannot get right for the life of me. For Instance, If I select REVISE/AND RESUBMIT in the row 01 CASEWORK LEVEL 1/ AREA A/ RM 125 the Data table will look like this:

01	CASEWORK	LEVEL 1/ AREA A/ RM 124
01	CASEWORK	LEVEL 1/ AREA A/ RM 125
01	CASEWORK	LEVEL 1/ AREA A/ RM 126
01	CASEWORK	LEVEL 1/ AREA A/ RM 133
01	CASEWORK	LEVEL 1/ AREA A/ RM 134
02	WALL PANELS	LEVEL 1/ AREA A/ RM 125
02	WALL PANELS	LEVEL 1/ AREA A/ RM 133
02	WALL PANELS	LEVEL 1/ AREA A/ RM 134
01	CASEWORK	LEVEL 1/ AREA A/ RM 125/ REV 7

Then If I select REVISE/AND RESUBMIT for 01 CASEWORK LEVEL 1/ AREA A/ RM 125/REV 7 will add it down and go up one to 01 CASEWORK LEVEL 1/ AREA A/ RM 125/REV 8.

Let me give a scenario where it would be working perfectly. In the first data set above, say a user selects REVISE/AND RESUBMIT to the following rows in this order
01 CASEWORK LEVEL 1/AREA A/ RM 125 then 01 CASEWORK LEVEL 1/ AREA A/ RM 126 then again but to the new 01 CASEWORK LEVEL 1/AREA A/ RM 125/ REV 1 (not the original 01 CASEWORK LEVEL 1/AREA A/RM 125 Row, the new row once this code is working properly) the data table should look like this:

01	CASEWORK	LEVEL 1/ AREA A/ RM 124
01	CASEWORK	LEVEL 1/ AREA A/ RM 125
01	CASEWORK	LEVEL 1/ AREA A/ RM 126
01	CASEWORK	LEVEL 1/ AREA A/ RM 133
01	CASEWORK	LEVEL 1/ AREA A/ RM 134
02	WALL PANELS	LEVEL 1/ AREA A/ RM 125
02	WALL PANELS	LEVEL 1/ AREA A/ RM 133
02	WALL PANELS	LEVEL 1/ AREA A/ RM 134

01	CASEWORK	LEVEL 1/ AREA A/ RM 125/ REV 1
01	CASEWORK	LEVEL 1/ AREA A/ RM 126/ REV 1
01	CASEWORK	LEVEL 1/ AREA A/ RM 125/ REV 2

How can I write the code to where it is keeping track of the times this string has occurred in the column and just go up + 1 from that? Also, if it the first time being revised it has to add the "/ REV 1" and then each revision after for that particular Room/ Location it needs to go up a revision Number.

Sorry for the long post but I've tried to get help on this before and it seems I am not explaining it clearly, my bad.
If it helps, here is a dropbox link with the data in it. Go to sheet DRAWING SCHEDULE and in Column K you'll find the In cell drop down to select REVISE/AND RESUBMIT to test this code. Thanks!

https://www.dropbox.com/s/y1oqkgfe6ly84pj/MR Drawing Transmittals Master Form 2019 v1.0.xlsm?dl=0

MickG · Jan 25, 2019

Try this:-

Code:

Public Sub REVISED(trow As Double)
    
Dim erow As Double
Dim Dn As Range
Dim Rng As Range
Dim vTxt As String
'Copy Cells down to next Blank Row
erow = Sheets("DRAWING SCHEDULE").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
Range(Cells(trow, 1), Cells(trow, 3)).Copy Sheets("DRAWING SCHEDULE").Cells(erow, 1)
sp = Split(Cells(erow, "C"), "/")
vTxt = sp(0) & "/" & sp(1) & "/" & sp(2)
nTxt = sp(0) & sp(1) & sp(2)

'Renames deplicate to REV #
Set Rng = Range(Range("C11"), Range("C" & Rows.Count).End(xlUp))
For Each Dn In Rng
    sp = Split(Dn.Value, "/")
    txt = sp(0) & sp(1) & sp(2)
    If txt = nTxt Then
      c = c + 1
    End If
Next
   Rng(Rng.Count).Value = vTxt & "/ REV " & c - 1
End Sub

USFengBULLS · Jan 25, 2019

Thanks again MickG. Its works great so far but the only issue that I can find so far is its starts at REV 2 on the first Revision count instead of at 1. Below is a quick test I did when setting the cell to REVISE/AND RESUBMIT.
I did it in this order:
LEVEL 1/ AREA A/ RM 133 = LEVEL 1/ AREA A/ RM 133/ REV 2
LEVEL 1/ AREA A/ RM 133/ REV 2 = LEVEL 1/ AREA A/ RM 133/ REV 3

LEVEL 1/ AREA A/ RM 125 = LEVEL 1/ AREA A/ RM 125/ REV 2
LEVEL 1/ AREA A/ RM 125/ REV 2 = LEVEL 1/ AREA A/ RM 125/ REV 3

01	CASEWORK	LEVEL 1/ AREA A/ RM 124
01	CASEWORK	LEVEL 1/ AREA A/ RM 125
01	CASEWORK	LEVEL 1/ AREA A/ RM 126
01	CASEWORK	LEVEL 1/ AREA A/ RM 133	REVISE/AND
01	CASEWORK	LEVEL 1/ AREA A/ RM 134
02	WALL PANELS	LEVEL 1/ AREA A/ RM 125	REVISE/AND
02	WALL PANELS	LEVEL 1/ AREA A/ RM 133
02	WALL PANELS	LEVEL 1/ AREA A/ RM 134
01	CASEWORK	LEVEL 1/ AREA A/ RM 133/ REV 2	REVISE/AND
01	CASEWORK	LEVEL 1/ AREA A/ RM 133/ REV 3
02	WALL PANELS	LEVEL 1/ AREA A/ RM 125/ REV 2	REVISE/AND
02	WALL PANELS	LEVEL 1/ AREA A/ RM 125/ REV 3

Also, we need to have it look in the B or A column to make sure we are making the revision to the location that is in that set of drawings. That's my bad, I'm testing this as I go.
Look at RM 133 below. It should be the first Revision (or REV 2 until code is fixed) for that room in the WALL PANEL drawing set.

01	CASEWORK	LEVEL 1/ AREA A/ RM 124
01	CASEWORK	LEVEL 1/ AREA A/ RM 125
01	CASEWORK	LEVEL 1/ AREA A/ RM 126
01	CASEWORK	LEVEL 1/ AREA A/ RM 133
01	CASEWORK	LEVEL 1/ AREA A/ RM 134
02	WALL PANELS	LEVEL 1/ AREA A/ RM 125
02	WALL PANELS	LEVEL 1/ AREA A/ RM 133
02	WALL PANELS	LEVEL 1/ AREA A/ RM 134
01	CASEWORK	LEVEL 1/ AREA A/ RM 133/ REV 2
01	CASEWORK	LEVEL 1/ AREA A/ RM 133/ REV 3
02	WALL PANELS	LEVEL 1/ AREA A/ RM 125/ REV 2
02	WALL PANELS	LEVEL 1/ AREA A/ RM 125/ REV 3
01	CASEWORK	LEVEL 1/ AREA A/ RM 134/ REV 2
02	WALL PANELS	LEVEL 1/ AREA A/ RM 133/ REV 4

Fluff · Jan 25, 2019

Cross posted https://www.excelforum.com/excel-pr...ber-of-occurrences-in-column.html#post5051890

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

USFengBULLS · Jan 25, 2019

I tried Deleting that other post as soon as I saw the notification about it. Sorry about this, won't happen again.

https://www.excelforum.com/excel-pr...ber-of-occurrences-in-column.html#post5051890

MickG · Jan 26, 2019

Try this:-
The reason it started with "Rev 2" is the code was not taking account of column "B", and counted the column "B" version as 2 instead of 1.
NB:- This code works based on the column "B" format staying the same.

Code:

Public Sub REVISED(trow As Double)
    
Dim erow As Double
Dim Dn As Range
Dim Rng As Range
Dim vTxt As String
'Copy Cells down to next Blank Row
erow = Sheets("DRAWING SCHEDULE").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
Range(Cells(trow, 1), Cells(trow, 3)).Copy Sheets("DRAWING SCHEDULE").Cells(erow, 1)
sp = Split(Cells(erow, "C"), "/")
vTxt = sp(0) & "/" & sp(1) & "/" & sp(2)
nTxt = Cells(erow, "B") & sp(0) & sp(1) & sp(2)

'Renames deplicate to REV #
Set Rng = Range(Range("C11"), Range("C" & Rows.Count).End(xlUp))
For Each Dn In Rng
    sp = Split(Dn.Value, "/")
    txt = Dn.Offset(, -1).Value & sp(0) & sp(1) & sp(2)
    If txt = nTxt Then
      c = c + 1
    End If
Next
   Rng(Rng.Count).Value = vTxt & "/ REV " & c - 1
End Sub

USFengBULLS · Jan 28, 2019

This is Glorious MickG, working exactly how it needs to. If you have time, please explain your code starting from line sp = Split(cells(erow, "C"), "/") and down. I'd like to learn more on how you developed this. Thanks so much MickG.

MickG · Jan 28, 2019

You're welcome.

Hope this helps:-

Code:

Public [COLOR=navy]Sub[/COLOR] REVISED(trow [COLOR=navy]As[/COLOR] Double)
    
[COLOR=navy]Dim[/COLOR] erow [COLOR=navy]As[/COLOR] Double
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] vTxt [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
'[COLOR=green][B]Copy Cells down to next Blank Row[/B][/COLOR]
erow = Sheets("DRAWING SCHEDULE").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
Range(Cells(trow, 1), Cells(trow, 3)).Copy Sheets("DRAWING SCHEDULE").Cells(erow, 1)
'[COLOR=green][B]How it works[/B][/COLOR]
'[COLOR=green][B]Split the row (Column "C") selected in column (k) Validation list, by "/"[/B][/COLOR]
sp = Split(Cells(erow, "C"), "/")

'[COLOR=green][B]Concatenate the first 3 values from the split value above, to form vTxt[/B][/COLOR]
'[COLOR=green][B]This is to add back to the Value at bottom of Column "C" along with "/ Rev?"[/B][/COLOR]
vTxt = sp(0) & "/" & sp(1) & "/" & sp(2)

'[COLOR=green][B]nTxt is the concatenation of columns "B" & split values in "C"[/B][/COLOR]
nTxt = Cells(erow, "B") & sp(0) & sp(1) & sp(2)

'[COLOR=green][B]set column "C" as range object[/B][/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("C11"), Range("C" & Rows.Count).End(xlUp))

'[COLOR=green][B]The loop is to count the duplicates of columns "B" Data when equalling  nTxt[/B][/COLOR]
'[COLOR=green][B]variable "c" is increased where column "B" & "C" equal each other, as shown in loop below.[/B][/COLOR]

'[COLOR=green][B]Nb:- The data in "C" has to be split by "/" , and the first 3 indexes Concatenated together.[/B][/COLOR]
'[COLOR=green][B]This is because some of the lines in "C" are the same except for the value "/ Rev number", and[/B][/COLOR]
'[COLOR=green][B]we need to think of them as the same value, in order to count them.[/B][/COLOR]

[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    sp = Split(Dn.Value, "/")
    txt = Dn.Offset(, -1).Value & sp(0) & sp(1) & sp(2)
    [COLOR=navy]If[/COLOR] txt = nTxt [COLOR=navy]Then[/COLOR]
      c = c + 1
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
'[COLOR=green][B]Last line in "C" filled  with the string "vtxt" and the new:-  "/ Rev No"[/B][/COLOR]
   Rng(Rng.Count).Value = vTxt & "/ REV " & c - 1
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

How to Increment a Alphanumeric String on Number of occurrences in Column

USFengBULLS

Board Regular

Excel Facts

MickG

MrExcel MVP

USFengBULLS

Board Regular

Fluff

MrExcel MVP, Moderator

USFengBULLS

Board Regular

MickG

MrExcel MVP

USFengBULLS

Board Regular

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

How to Increment a Alphanumeric String on Number of occurrences in Column

Board Regular

Excel Facts

MrExcel MVP

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock