Solved loop through range and write unique value to next blank row

May 13, 2019 at 14:08:20
Specs: Windows 7
I got this working code from @DerbyDad03, I would like to modify it so that it writes each unique value to a sheet named "Validation Data" inside the same workbook to the next blank row starting in A2.

I tired fiddling with it because there is a lot of examples but I can't make it work..

Sub LCs2_In_Selection()
'Move visible email addresses to Sheet2.ColumnASheets(2).Cells.ClearContents
Sheets(2).Cells.ClearContents
  lastSrcRw = Sheets("Pipeline").Cells(Rows.Count, 2).End(xlUp).Row
     For Each cell In Sheets("Pipeline").Range("E11:E" & lastSrcRw).SpecialCells(xlCellTypeVisible)
        dstRw = dstRw + 1
        cell.Copy Sheets(2).Range("A" & dstRw)
     Next
  
  
'Loop through Sheet2 list, extract unique addresses
  lastTmpRw = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
     For tmpRw = 1 To lastTmpRw
         If WorksheetFunction.CountIf(Sheets(2).Range("A1:A" & tmpRw), _
            Sheets(2).Range("A" & tmpRw)) < 2 Then
         'CODE TO WRITE THE VALUE TO "VALIDATION DATA SHEET" NEXT BLANK ROW STARTING IN A2
         End If
     Next tmpRw
     
End Sub


See More: loop through range and write unique value to next blank row

Reply ↓  Report •

#1
May 13, 2019 at 19:00:18
✔ Best Answer
Once you have your list (with duplicates) in Sheet2, why not create a filtered list of Unique values instead of looping? It's probably more efficient. No need for the COUNTIF if your goal is to put the values in a sheet. That was only needed since you were building the email string.

A quick use of the Macro Recorder produced this code, which I would then modify to fit my needs:

Sub Macro1()
'
' Macro1 Macro
'

'
Sheets("Sheet2").Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Sheet3").Range("A1"), Unique:=True
End Sub

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code

message edited by DerbyDad03


Reply ↓  Report •
Related Solutions


Ask Question