PDA

View Full Version : Need macro for taking data from one sheet and autopopulating another



Abdoon
05-21-2013, 12:52 PM
Hey everyone,

I am having trouble with a program i'm trying to write in vba. I didn't think it would be too complicated, but I haven't worked much with programming in excel and don't know all the correct verbiage compared to C (which I know much better).
So I have a spreadsheet with a list of different items (i.e. projects being worked on) in one column of sheet 2. An example of what is seen in the projects column is shown below

Projects

Charitable Donation
Charitable Donation
Charitable Donation
Special Offers Page
Special Offers Page

The reason they are listed more than once is because that is how the spread sheet is listed (that's where the challenge for me comes in). What I am attempting to do is copy the "projects" column from sheet 2 into sheet 1, BUT without having more than one copy of the duplicate projects. For example, I want to copy just one "Charitable Donation", and one "Special Offers Page".

Here's what I have so far, I just don't know what to do in order to get just one copy of each project. I am currently getting all copies of all projects.

Sub projects()
For i = 1 To 1000

Sheets("Data").Activate
If Cells(i + 1, 9) <> Cells(i, 9) Then Cells(i + 1, 9).Copy
Sheets("Metrics").Select
Cells(i, 1).Select
ActiveSheet.Paste

Next i

For i = 1 To 1000
Sheets("Metrics").Select
If Cells(i, 1) = Cells(i + 1, 1) Then Cells(i, 1).EntireRow.Delete
Next i

End Sub

*Note - Sheet 1 is "Metrics" and Sheet 2 is "Data".
Any help would be greatly appreciated, hope this makes sense. Its mainly the second "For" loop that I'm not sure how to write. Thanks!

EirikDaude
05-22-2013, 02:08 AM
I think this does more or less what you are asking for?
Option Explicit
Option Base 1

Sub findUniqueValues()

Dim data As Range, c As Range, projectName As String, elementsFound As Integer
Dim projects() As String, inArray As Boolean, arrayDimensioned As Boolean

arrayDimensioned = False: elementsFound = 0

' Set the range to search for unique values
With Worksheets("Data")
Set data = .Range(.Range("I1"), .Range("I1048576").End(xlUp))
End With

' Populate the array with unique values from the selected range
For Each c In data
projectName = CStr(c.Value)

' Is the projectname already in the array?
On Error Resume Next
If Application.WorksheetFunction.Match(projectName, projects, 0) < 1 Then
inArray = False
Else
inArray = True
End If
On Error GoTo 0

' If not, add it to the array
If Not inArray Then
' We need some special handling for the first element added to the array
If arrayDimensioned Then
ReDim Preserve projects(LBound(projects) To UBound(projects) + 1) As String
Else
ReDim projects(1 To 1) As String
arrayDimensioned = True
End If
projects(UBound(projects)) = projectName
' And finally write it to the other sheet
Worksheets("Metrics").Range("A1").Offset(elementsFound, 0) = projectName
elementsFound = elementsFound + 1
End If
Next
End Sub

snb
05-22-2013, 02:19 AM
Use advancedfilter (in the UI) or in VBA to copy only unica to another place.


sub M_snb()
columns(2).advancedfilter xlfiltercopy,,sheets("new").cells(1),true
End Sub


In a table (VBA: Listobject) you can use 'remove duplicates'.

Abdoon
05-22-2013, 06:50 AM
Thanks for the replies!
So I'm trying to run through what you wrote EirikDaude and just trying to fully understand it. Once again, I'm new to vba and am trying to teach it to myself over the next few days, so any help is greatly appreciated! :)
When I run the code, I am getting some errors.
On "Set data = .Range(.Range("I1"), .Range("I1048576").End(x1Up))", I am getting a run-time error '1004' application-defined or object defined error"
Then I am getting an error for the line that reads "For Each c in data", that says run-time error '424': Object required. Anyone know what to do about those? Thanks in advance!