Have a Macro that needs editing to pull initials from columns O and U, and from all sheets thats in the file not just the currently selected. I'm not sure what to change to achieve that. Any help would be great.


Dim newWS As Worksheet, r As Long, N As Long, i As Integer
Application.ScreenUpdating = False
For Each ws In Sheets
Application.DisplayAlerts = False
If ws.Name = "UNIQUE_DATA" Then ws.Delete
Application.DisplayAlerts = True
Next
Set newWS = Sheets.Add(after:=Sheets(Sheets.Count))
newWS.Name = "UNIQUE_DATA"
N = 1
For i = 1 To Sheets.Count - 1
r = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
Sheets(i).Range("A1:A" & r).Copy
Cells(N, 1).PasteSpecial xlValues
N = Cells(Rows.Count, "A").End(xlUp).Row + 1
Next
r = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:A" & r).AdvancedFilter Action:=xlFilterInPlace, Unique:=False
Range("A1:A" & r).Copy
Range("B1").PasteSpecial xlValues
Application.CutCopyMode = False
Range("A1:A" & r).AdvancedFilter Action:=xlFilterInPlace, Unique:=False
Columns(1).Delete
r = Cells(Rows.Count, "A").End(xlUp).Row
Dim rr As Integer
rr = r
Dim itemscnt() As String
ReDim itemscnt(rr)
Dim itemcnt() As Integer
ReDim itemcnt(rr)
Range("A1:A" & r).Sort key1:=Range("A1"), Header:=xlNo
Dim index As Integer
index = 0
For Each recordval In Range("A1:A" & r)
pos = Application.Match(recordval, itemscnt, False)

If Not IsError(pos) Then
Rem MsgBox recordval & " is at position " & pos
itemcnt(pos - 1) = itemcnt(pos - 1) + 1
Else
Rem MsgBox recordval & " not found!"
itemscnt(index) = recordval
itemcnt(index) = 1
index = index + 1
End If
Next
Range("A1:A" & r).Clear
Dim Row As Integer
Row = 1
For i = LBound(itemscnt, 1) To UBound(itemscnt, 1)
If itemcnt(i) > 0 Then
Sheets("UNIQUE_DATA").Cells(Row, 1).Value = itemscnt(i)
Sheets("UNIQUE_DATA").Cells(Row, 2).Value = itemcnt(i)

Row = Row + 1
End If
Next i
Application.ScreenUpdating = True