I am finishing a project and seems like the last part is the most difficult.
I have 7 (6 + 1 optional) columns that have this sort data (some of them have only earlier/later/na, and some of them earlier/later/equals/na). For example three rows:
OK OK No Yes Earlier Earlier N/A OK OK No Yes Earlier Earlier Earlier OK Missed Yes Yes Later Later Earlier
These can end in 13 different scenarios (if it's "ok ok no yes earlier earlier n/a" would come to for example "a = a + 1"). What I need is to actually count how many of each scenario happened (from "a" to "m"). Also for example if the first three columns are "OK OK OK" I dont need to consider the following conditions and straight add it to f.e. b = b + 1 and go to the next row.
My question here is how efficiently I can do that having in mind that I will have more than 50,000 rows? I understand that I could do that with IF, but I would just get lost in all the if's and I believe this will take a lot of time for macro to run through all the scenarios.
I appreciate all your help and support.Answer1:
OK this is a starter using the Excel SubTotal function within VBA
It has assumptions built-in to the code which you may want to change, including that the 'solution' is currently in the same sheet as the data (currently in a sheet called "Scenarios", starting in col A and row 7). This works with a limited amount of data but to 50k rows worth! You can add code to summarise the statistics as you wish and remove the subtotals. It leaves the original data intact.
Sub scenarios() Dim ws As Worksheet Dim strow As Long, endrow As Long, stcol As Long, endcol As Long Dim r As Long, c As Long Dim newstr As String Dim cl As Range, rng As Range, drng As Range Dim strArr() As String strow = 7 stcol = 1 'Col A endcol = 7 '7 variables Set ws = Sheets("Scenarios") With ws 'find last data row endrow = Cells(Rows.Count, stcol).End(xlUp).Row 'for each data row For r = strow To endrow newstr = "" 'produce concatenated string of that row For c = stcol To endcol newstr = newstr & .Cells(r, c) Next c 'put string into array ReDim Preserve strArr(r - strow) strArr(r - strow) = newstr Next r 'put array to worksheet Set drng = .Range(.Cells(strow, endcol + 4), .Cells(endrow, endcol + 4)) drng = Application.Transpose(strArr) 'sort newly copied range drng.Sort Key1:=.Cells(strow, endcol + 4), Order1:=xlAscending, Header:=xlNo 'provide a header row for SubTotal .Cells(strow - 1, endcol + 4) = "Header" 'resize range to include header drng.Offset(-1, 0).Resize(drng.Rows.Count + 1, drng.Columns.Count).Select 'apply Excel SubTotal function Selection.Subtotal GroupBy:=1, Function:=xlCount, Totallist:=Array(1) End With End Sub