Dim arrBrandQuestions = Survey.Questions.FilterByTag("GrpBanner") Dim arrScale5Questions = Survey.Questions.FilterByTag("5pt Scale Brand Loop") ' tagged: R4 Dim resPortfolio As Portfolio Dim resItem As PortfolioItem Dim ProfileRow as Profile ' 1. Loop through each response and set if it's selected or not (keeps all responses in original order) Dim h For h = 1 to arrBrandQuestions.Count Dim currQuestionProfile as ProfileQuestion currQuestionProfile.Question = arrBrandQuestions[h] Dim k For k = 1 to arrBrandQuestions[h].Responses.Count Dim myResponses as ProfileItem myResponses.Type = 0 myResponses.Response = k If k in {1;3;5} Then myResponses.Selected = True Else myResponses.Selected = False Endif currQuestionProfile.Add(myResponses) Next k ProfileRow.Add(currQuestionProfile) Next h ' Can replace lines 10-24 with: - ProfileRow.Add(arrBrandQuestions[h],{1;3;5}) - See next examples ' 2. Reverse each question's responses (& remove 'Not asked') Dim i For i=1 to arrScale5Questions.Count If arrScale5Questions[i].IsCoding = False Then ProfileRow.Add(arrScale5Questions[i],arrScale5Questions[i].Responses.Index.SortDesc() - 6) Endif Next i ' 3. Select responses of question(s) where counts > 1 Dim j Dim arrCountsGreaterThan1 = {} For j = 1 to B2_Permutations.Responses.Count ' Loop through all responses of the question, B2_Permutations If B2_Permutations.Data.Counts({}+j)[1] > 1 Then ' Check for responses which have counts > 1 arrCountsGreaterThan1 = arrCountsGreaterThan1 + j ' Add them to an array Endif Next j ProfileRow.Add(B2_Permutations,arrCountsGreaterThan1) ' Add the question to the rows and select responses where counts > 1 ' Debug.Trace("arrCountsGreaterThan1: " + arrCountsGreaterThan1) resItem.SetType(1) resItem.SetTitle("TAB1") resItem.TabDef.ReadTabTemplate("Askia Simple") resItem.TabDef.Rows.Add(ProfileRow) resPortfolio.Add(resItem) ResPortfolio.Save(Survey.Directory + "7. Deselect Responses for Profile Questions.xml") resPortfolio.Open()