• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Help with advanced VBA task please

J

johnelstad

New Member
I'm comfortable with formulas, but very new to VBA and suddenly I have a task so advanced I don't even know where to start.


I need a script that will go through all the rows in Column A (starting on row 2), create a range for matching cells (they'll be contiguous) and check if the cells of that range in Column B are "Closed". The script will then remove the duplicate rows and replace "Closed" with the percentage of "Closed" cells in that range. Below is a sample Before and After using dummy text (columns separated by commas):


Column A, Column B

cat, Closed

cat, Closed

cat, Closed

dog, Closed

dog, In Progress

horse, QA Queue

horse, In Progress

horse, In Progress

horse, QA Queue


cat, 100%

dog, 50%

horse, 0%


Thanks in advance for any help you can provide!
 
I am new to VBA too. I don't think I can help too much with the actual coding, but the logic I can do.

Now, if can I explain it....


I wonder if an Array would work where the elements are String, Int, Int. The string is the unique name in column A, only stored once. The first Int is the number of occurances of the unique name as it goes down column A, and the second Int is to count the instances of 'CLOSED in column B for every instance of A.


If you go down column A, you create an array. So for column A, the String gets set to "CAT" , 1, 1. Next row you check to see if your array already contains a CAT, and if so, increment the first Int to 2 and check to see if it is closed and increment the second Int. If the next row doesn't contain a CAT, then add the new element to the array with the two ints.


So as you go down, your array starts to look something like this....

CAT,3,3,DOG,2,1,Horse,4,0.....


Then at the end you can deconstruct it in to a table that only shows CAT, DOG and Horse, and use the 3,3 the 2,1 and the 4,0 to derive your percentages.


CAVEAT. I am not an excel expert, and there might be a simple formula to do this. But I think my logic works. I know that some languages allow you to create an array with an indeterminate number of elements, and other do not, so depending on what VBA is, this method may or may not work. But I hope it helps you think out the problem more.
 
Here's the code that should work for you.

[pre]
Code: 
Sub SummarizeList()
Dim LastRow As Integer
Dim StartRecord As Integer
Dim RecordCount As Integer
Dim RecordValue As String

Application.ScreenUpdating = False
'Determine the last record
LastRow = Range("a65536").End(xlUp).Row

'setup initial values
StartRecord = LastRow
RecordValue = Cells(LastRow, "A").Value

For i = LastRow - 1 To 2 Step -1
'Doing a comparison w/ the row above
If Cells(i - 1, "A") <> RecordValue Then
'Do a COUNTIF on only the cells we care about
RecordCount = WorksheetFunction.CountIf(Range(Cells(i, "B"), _
Cells(StartRecord, "B")), "Closed")
'calulate the percentage
Cells(i, "B") = Format(RecordCount / (StartRecord + 1 - i), "0%")
'delete the duplicate rows
Range(Cells(i + 1, "A"), Cells(StartRecord, "A")).EntireRow.Delete

'setup new values
StartRecord = i - 1
RecordValue = Cells(i - 1, "A").Value
End If
Next

Application.ScreenUpdating = False
End Sub
[/pre]
 
Thanks to both of you for the quick replies.


Luke, your script works like magic on the sample data, but seems to get tripped up on the actual data I'm using (see excerpt below). Note if you run it on the data below it completely deletes many of the ranges. I'm embarrassed to ask for more help, but I don't know how I would edit your code to address this issue.


Thanks so much for your help!


032512_Elec_iPod&MP3_Accessories_L3_Grid1A, Closed

032512_Elec_iPod&MP3_L2_Utility, Development :: Queue

032512_Elec_iPod&MP3_L2_Utility, Closed

032512_Elec_TVs&Video_DVD&Blu-rayPlayers_L3_Utility1, Closed

032512_Elec_TVs&Video_DVD&Blu-rayPlayers_L3_Utility1, Closed

032512_Elec_VideoGames_L2_Utility1, Closed

032512_Elec_VideoGames_L2_Utility1, Closed

032512_Elec_VideoGames_L2_Utility1, Closed

032512_Elec_VideoGames_L2_Utility1, Closed

032512_Elec_VideoGames_Nintendo3DS_L3_Combo, Closed

032512_Elec_VideoGames_NintendoDS_L3_Combo, Closed

032512_Elec_VideoGames_NintendoWii_L3_Combo, Closed

032512_Elec_VideoGames_NintendoWii_L3_Combo, Closed

032512_Elec_VideoGames_NintendoWii_L3_Combo, Closed

032512_Elec_VideoGames_PCgames_L3_Grid+, Closed

032512_Elec_VideoGames_PS3_L3_Combo, Closed

032512_Elec_VideoGames_PSP_L3_Combo, Closed

032512_Elec_VideoGames_XBOX360_L3_Combo, Closed

032512_Elec_VideoGames_XBOX360_L3_Combo, Closed

032512_Elec_VideoGames_XBOX360_L3_Combo, Closed

032512_Entertainment_Books_ClubPicks_L3_GridPlus, Development :: Queue

032512_Entertainment_Books_KidsBooks_L3_Combo, Closed

032512_Entertainment_Books_L2_Utility1A, Closed

032512_Entertainment_Books_L2_Utility1A, Closed

032512_Entertainment_Books_L2_Utility1A, Closed

032512_Entertainment_Books_L2_Utility1A, Closed

032512_Entertainment_L1_Utility1A, Closed

032512_Entertainment_L1_Utility1A, Development :: Queue

032512_Entertainment_L1_Utility1A, Closed
 
Hi Luke,


A quick follow up, I think that ranges of only one row are causing the problem. I created a shorter sample data set with some singletons:


dog,Closed

dog,Closed

cat,Closed

horse,sdfd

mouse,Closed

mouse,sdfdfd

rat,Closed


With this result:


dog, 100%


This isn't your fault as I didn't include any singletons in my example. If a singleton is Closed, it should be 100%, otherwise 0%. Sorry for the tardy change in requirements and thanks again!
 
Oops. =(

No worries, just need to add a few minor tweaks.

[pre]
Code: 
Sub SummarizeList()
Dim LastRow As Integer
Dim StartRecord As Integer
Dim RecordCount As Integer
Dim RecordValue As String

Application.ScreenUpdating = False
'Determine the last record
LastRow = Range("a65536").End(xlUp).Row

'setup initial values
StartRecord = LastRow
RecordValue = Cells(LastRow, "A").Value

For i = LastRow To 2 Step -1
'Doing a comparison w/ the row above
If Cells(i - 1, "A") <> RecordValue Then
'Do a COUNTIF on only the cells we care about
RecordCount = WorksheetFunction.CountIf(Range(Cells(i, "B"), _
Cells(StartRecord, "B")), "Closed")
'calulate the percentage
Cells(i, "B") = Format(RecordCount / (StartRecord + 1 - i), "0%")
'delete the duplicate rows IF NEEDED
If i < StartRecord Then
Range(Cells(i + 1, "A"), Cells(StartRecord, "A")).EntireRow.Delete
End If
'setup new values
StartRecord = i - 1
RecordValue = Cells(i - 1, "A").Value
End If
Next

Application.ScreenUpdating = False
End Sub
This translated your last example into:

dog	100%
cat	100%
horse	0%
mouse	50%
rat	100%
[/pre]
 
HUZZAH! It works brilliantly. Thanks so much for all your help. I'm going to study your code so that I can do future variations on my own.
 
Hi Johnelstad,


While I definitely agree with solution of Luke M, but I was thinking why not use a native feature of excel by using pivot table?


you can present the have status(Closed, in queue, etc) as column and summarize values by count and show values as % of row total.


One catch here is it will show % of activities in all the status including closed. If you need only closed, then hide the columns that you dont want to see.


Just thought of sharing this, as many instances, we may not be able to put vba codes.


Regards,

Prasad DN
 
You must log in or register to reply here.
Back
Top