help with code

[timmulla]

I have a workbook with three worksheets.

sheet1
sheet2
sheet3


Can anyone help me create code to do the following.

Create a new worksheet and name it "Report"

Create a list unique records from column A:A in sheet1, sheet2, and sheets3
and put in Column A:A in the newly created worksheet ("Report"). The
worksheets may have duplicate records so I'm trying to create a list of
unique records from my three worksheets.

Thanks,

 

[Don Guillett]

Maybe the macro recorder can help you learn.
record a macro for adding and naming a sheet
record a macro using data>filter>advanced filter>unique>copy

 

[Bob Phillips]

Sub ProcessData()
Dim LastRow As Long

Worksheets.Add
ActiveSheet.Name = "Report"
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1").Resize(LastRow).Copy ActiveSheet.Range("A1")
End With
With Worksheets("Sheet2")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1").Resize(LastRow).Copy
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0)
End With
With Worksheets("Sheet3")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1").Resize(LastRow).Copy
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0)
End With
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B1").FormulaR1C1 = "=COUNTIF(R1C1:RC[-1],RC[-1])"
.Range("B1").AutoFill Destination:=Range("B1").Resize(LastRow)
.Rows(1).Insert
.Range("B1").Value = "temp"
.Range("B1").Resize(LastRow + 1).AutoFilter Field:=1,
Criteria1:=">1", Operator:=xlAnd
.Range("B1").Resize(LastRow +
1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Joel]

Sub findunique()

Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Report"

NewRow = 1
For Each sht In ThisWorkbook.Sheets
If sht.Name <> "Report" Then

LastRow = sht.Cells(Rows.Count, "A").End(xlUp).Row
For RowCount = 1 To LastRow
If sht.Range("A" & RowCount) <> "" Then
data = sht.Range("A" & RowCount)
With Sheets("Report")
Set c = .Columns("A:A").Find(what:=data, _
LookIn:=xlValues)
If c Is Nothing Then
.Range("A" & NewRow) = data
NewRow = NewRow + 1
End If
End With
End If
Next RowCount
End If
Next sht


End Sub

 

[Gary''s Student]

Sub Macro1()
Sheets.Add
ActiveSheet.Name = "Report"
For i = 1 To 3
Sheets("sheet" & i).Activate
Set r = Range("A1")
Range(r, r.End(xlDown)).Copy
Sheets("Report").Activate
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & n).Select
ActiveSheet.Paste
Next
MsgBox (" ")
Set r = Range("A:A")
For j = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
v = Cells(j, "A").Value
k = Application.WorksheetFunction.CountIf(r, v)
If k > 1 Then
Cells(j, "A").EntireRow.Delete
End If
Next
End Sub