My VBA script is "almost" completed, but needs help correcting some errors before it works.
The script is supposed to loop through filters in Regions!B5 (it's the column header) for data in Regions!B6:B553, then after filtering, copy Regions!A3:R3 to Temp!A1:R1 for each unique filtered value. For example, if there are 10 unique IDs in Regions!B, Temp!A1:R1 should have one row for each value, creating a dataset from A1:R1, to A10:R10.
For whatever reason, the final output generated on RegionsSummary! is not looping through each filter to copy+Paste on the sheet, it is pasting duplicates of the first unique filter value, for as many times as there are unique values in regions!B.
Can anyone identify the error? It's likely having to do with LR3 on RegionSummary, finding the last row. Nothing (according to the code) exists on RegionSummary, so it only applies the pasted value to row LR3+1 in column A. That doesn't change, so the loop keeps overwriting. If Dim LR3 is put outside of the loop, then ReDim inside of the loop, it might work, but I'm not sure how this could be accomplished. Here is the file link: http://s000.tinyupload.com/dow…2773662777787382231444371 I appreciate any help!
Sub Testing() ' Gets Number of Row in Regions Sheet Sheets("Regions").Activate LR1 = Cells(Rows.Count, "A").End(xlUp).Row 'Creates a New Worksheet and copy's the data from regions, enters the copied data into the 'New Temp Sheet and then removes the duplicates to create your list of unique items to filter on 'Creating the New WorkSheet Sheets.Add.Name = "Temp" 'Copy the data Sheets("Regions").Activate Range("A6:R" & LR1).Select Selection.Copy 'Paste the data into Temp Sheet Sheets("Temp").Activate Range("A1").Select ActiveSheet.Paste 'Get Number of Rows pasted LR2 = Cells(Rows.Count, "A").End(xlUp).Row 'Remove the duplicates Cells.Select ActiveSheet.Range("A1:R" & LR2).RemoveDuplicates Columns:=2, Header:=xlNo 'Counts how many items left to check NumCheckVal = Cells(Rows.Count, "A").End(xlUp).Row 'Loop through each Item to filter on For e = 1 To NumCheckVal 'Assigns the Filter value CheckVal = Sheets("Temp").Range("B" & e) 'Navigate to the region sheet Sheets("Regions").Activate 'Filter the sheet ActiveSheet.Range("A5:R" & LR1).AutoFilter Field:=2, Criteria1:=CheckVal 'Copy the data Range("A3:R3").Select Selection.Copy 'Navigate to the RegionSummary Sheet and paste the values Sheets("RegionSummary").Activate 'If you dont want this to actually overwrite but rather add to the end of RegionSummary then uncomment the following Line ' and replace the range below Range("A12").Select should be changed to Range("A" & LR3 + 1).Select 'If left as is it will run through and just overwrite A12:R12 as it loops through ' Adjusting this will make it so that it steps down a row each time it runs through ' First Value on A12:R12 next Vlue on A13:R13 Etc until it runs through all the options LR3 = Cells(Rows.Count, "A").End(xlUp).Row Range("A" & LR3 + 1).Select ActiveSheet.Paste 'Go back to region sheet and unfilter Column B Sheets("Regions").Activate ActiveSheet.Range("A5:R" & LR2).AutoFilter Field:=2 'Run next loop Next e Application.DisplayAlerts = False Sheets("Temp").Delete Application.DisplayAlerts = True End sub