Macro to compare columns in 2 worksheets and paste to 3rd worksheet

**jsticca** · 10-28-2010, 04:51 PM

Hello,

I've been trying to come up with a macro to suit my need but haven't been able to figure it out. This is what I am trying to do:

1. I can create a spreadsheet from a database that lists all action items from various reviews. This spreadsheet cannot be edited but can be refreshed at any point in time to update the action item status.

2. I created a new blank worksheet in this workbook and filled in various review numbers that I care about [Column A].

3. The original spreadsheet with action items contains the action item numbers in one column which contain the review number within them [Column B]. So for review number AI-R5-2010-584659 the original spreadsheet would have all action items listed by AI-R5-2010-584659-01, AI-R5-2010-584659-02, etc.

4. I want to create a macro that compares the review number portion of the action item number in Column B of "Sheet1" to the review number in "Sheet2" and then copy all matching rows from "Sheet1" to a new worksheet [Sheet 3].

5. Additionally, I would like to copy the header row in Sheet1 to Sheet3 as well.

If I can automate this process it will be of great help for the future.

Hopefully this all makes sense and thanks for the help!

**rylo** · 10-28-2010, 09:09 PM

Hi

See how this goes.

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Sheet3")
  OutSH.Rows("1:1").Value = Sheets("SHeet1").Rows("1:1").Value
  
  With Sheets("sheet2")
    .Range("A:A").Copy Destination:=.Range("D:D")
    .Range("D1").Value = Sheets("Sheet1").Range("B1").Value
    For Each ce In .Range(.Range("D2"), .Range("D2").End(xlDown))
      ce.Value = ce.Value & "*"
    Next ce
    Set critrng = .Range(.Range("D1"), .Range("D1").End(xlDown))
  End With
  
  Sheets("Sheet1").Range("A1").CurrentRegion.AdvancedFilter action:=xlFilterCopy, copytorange:=OutSH.Range("A1:N1"), criteriarange:=critrng
  Sheets("Sheet2").Range("D:D").ClearContents
  
End Sub

rylo

**jsticca** · 10-29-2010, 12:10 PM

Awesome! This worked just as expected.

I added a few things to the code to make it a little more functional. The only other thing I would like to do is make all of the headers drop down lists in the "Project Action Items" worksheet. Any ideas?

Here is the code I have:

Sub AIList()

  Sheet1.ListObjects("List1").UpdateChanges xlListConflictDialog

  On Error Resume Next
  Application.DisplayAlerts = False
  Sheets("Project Action Items").Delete
  Application.DisplayAlerts = True
  On Error GoTo 0

  Dim OutSH As Worksheet
  Set OutSH = Sheets.Add
  OutSH.Name = "Project Action Items"
  OutSH.Rows("1:1").Value = Sheet1.Rows("1:1").Value
  
  With Sheet2
    .Range("A:A").Copy Destination:=.Range("D:D")
    .Range("D1").Value = Sheets("owssvr(1)").Range("B1").Value
    For Each ce In .Range(.Range("D2"), .Range("D2").End(xlDown))
      ce.Value = ce.Value & "*"
    Next ce
    Set critrng = .Range(.Range("D1"), .Range("D1").End(xlDown))
  End With
  
  Sheet1.Range("A1").CurrentRegion.AdvancedFilter action:=xlFilterCopy, copytorange:=OutSH.Range("A1:N1"), criteriarange:=critrng
  Sheet2.Range("D:D").ClearContents
  Sheets("Project Action Items").Columns.AutoFit
  Sheets("Project Action Items").Rows("1:1").Select
    Selection.Font.Bold = True
  
End Sub

Thanks!

**rylo** · 10-31-2010, 05:59 PM

Hi

How about an autofilter.

outsh.range("A1").currentregion.autofilter

rylo

Thread: Macro to compare columns in 2 worksheets and paste to 3rd worksheet

Thread Tools

Display

Macro to compare columns in 2 worksheets and paste to 3rd worksheet

Re: Macro to compare columns in 2 worksheets and paste to 3rd worksheet

Re: Macro to compare columns in 2 worksheets and paste to 3rd worksheet

Re: Macro to compare columns in 2 worksheets and paste to 3rd worksheet

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions