Hello,
1
I am using the below macro to auto transpose values from sheet 1 to sheet 2 .The macro already has values to remove duplicates and sort. Now, am looking for some help to add a code so that the duplicate values get highlighted and the total number of duplicate values show in D8 and the total number of non duplicate values show in D9.For example : out of 100 values, if 50 values are duplicate, then number "50" should show in D8 and Number "50"should show in D9..is this possible..please help
Private Sub CommandButton1_Click() 'Transposed to Sheet2 with a Blank Row between each Row Dim rng As Range, j As Long j = 2 With Sheets("Sheet1") .Range(Range("A3"), Range("A3").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo .Range("A3:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Sort Key1:=.Range("A3"), Order1:=xlAscending, Header:=xlNo For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row Step 1000 If i = .Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub Set rng = .Range(Cells(i, 1), Cells(i + 1000, 1)) Sheets("Sheet2").Cells(j, 1).Resize(1, rng.Count - 1) = Application.Transpose(rng) j = j + 2 Next i End With Sheets("Sheet2").Select End Sub
1
I am using the below macro to auto transpose values from sheet 1 to sheet 2 .The macro already has values to remove duplicates and sort. Now, am looking for some help to add a code so that the duplicate values get highlighted and the total number of duplicate values show in D8 and the total number of non duplicate values show in D9.For example : out of 100 values, if 50 values are duplicate, then number "50" should show in D8 and Number "50"should show in D9..is this possible..please help
Private Sub CommandButton1_Click() 'Transposed to Sheet2 with a Blank Row between each Row Dim rng As Range, j As Long j = 2 With Sheets("Sheet1") .Range(Range("A3"), Range("A3").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo .Range("A3:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Sort Key1:=.Range("A3"), Order1:=xlAscending, Header:=xlNo For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row Step 1000 If i = .Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub Set rng = .Range(Cells(i, 1), Cells(i + 1000, 1)) Sheets("Sheet2").Cells(j, 1).Resize(1, rng.Count - 1) = Application.Transpose(rng) j = j + 2 Next i End With Sheets("Sheet2").Select End Sub