?
Solved

Sheet 1 column URL's if found in sheet 2 any columns . Copy full rows to sheet 3

Posted on 2013-01-10
8
Medium Priority
?
391 Views
Last Modified: 2013-01-11
Sheet 1 column URL's if found in sheet 2 any columns . Copy full rows to sheet 3
Attached file
Need a macro that can do this
Copy-rows.xls
0
Comment
Question by:bsharath
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4
8 Comments
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 38766196
Hi

try
Sub kTest()
    
    Dim Sht1URLs, i   As Long, r As Range, n As Long
    
    Sht1URLs = Sheet1.Range("a1").CurrentRegion.Resize(, 1).Value2
    Application.ScreenUpdating = 0
    For i = 1 To UBound(Sht1URLs, 1)
        If Len(Sht1URLs(i, 1)) Then
            Set r = Sheet2.UsedRange.Cells.Find(Sht1URLs(i, 1), , , 1)
            If Not r Is Nothing Then
                n = n + 1
                r.EntireRow.Copy Sheet3.Cells(n, 1)
                Set r = Nothing
            End If
        End If
    Next
    'if you need to align the urls in first column
    With Sheet3.UsedRange
        On Error Resume Next
        .SpecialCells(4).Delete -4159
    End With
    Application.ScreenUpdating = 1
End Sub

Open in new window


Kris
0
 
LVL 11

Author Comment

by:bsharath
ID: 38766231
Perfect

there were 200 that were not moved

Can the sheet 1 have a color set to ones that were not moved

So i know what the issue was with them?
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 38766271
It is searching for an exact match. Try to replace this line

Set r = Sheet2.UsedRange.Cells.Find(Sht1URLs(i, 1), , , 1)

Open in new window


with

Set r = Sheet2.UsedRange.Cells.Find(Sht1URLs(i, 1), , , 2)

Open in new window


Kris
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 11

Author Comment

by:bsharath
ID: 38766283
Yes i want the exact match
What does the above change do?
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 38766307
That looks a partial match.

anyway try this one.

Sub kTest()
    
    Dim Sht1URLs, i   As Long, r As Range, n As Long, rngURL    As Range
    
    Set rngURL = Sheet1.Range("a1").CurrentRegion.Resize(, 1)
    Sht1URLs = rngURL.Value2
    
    Application.ScreenUpdating = 0
    For i = 1 To UBound(Sht1URLs, 1)
        If Len(Sht1URLs(i, 1)) Then
            Set r = Sheet2.UsedRange.Cells.Find(Sht1URLs(i, 1), , , 1)
            If Not r Is Nothing Then
                n = n + 1
                r.EntireRow.Copy Sheet3.Cells(n, 1)
                Set r = Nothing
            Else
                rngURL.Cells(i, 1).Interior.Color = 65535
            End If
        End If
    Next
    'if you need to align the urls in first column
    With Sheet3.UsedRange
        On Error Resume Next
        .SpecialCells(4).Delete -4159
    End With
    Application.ScreenUpdating = 1
End Sub

Open in new window


Kris
0
 
LVL 11

Author Comment

by:bsharath
ID: 38766334
If the URl has a start and end space it ignores

Can this be dealt?
0
 
LVL 18

Accepted Solution

by:
krishnakrkc earned 2000 total points
ID: 38766339
try

Sub kTest()
    
    Dim Sht1URLs, i   As Long, r As Range, n As Long
    Dim rngURL    As Range, URL As String
    
    Set rngURL = Sheet1.Range("a1").CurrentRegion.Resize(, 1)
    Sht1URLs = rngURL.Value2
    
    Application.ScreenUpdating = 0
    For i = 1 To UBound(Sht1URLs, 1)
        If Len(Sht1URLs(i, 1)) Then
            URL = Application.WorksheetFunction.Trim(Sht1URLs(i, 1))
            Set r = Sheet2.UsedRange.Cells.Find(URL, , , 1)
            If Not r Is Nothing Then
                n = n + 1
                r.EntireRow.Copy Sheet3.Cells(n, 1)
                Set r = Nothing
            Else
                rngURL.Cells(i, 1).Interior.Color = 65535
            End If
        End If
    Next
    'if you need to align the urls in first column
    With Sheet3.UsedRange
        On Error Resume Next
        .SpecialCells(4).Delete -4159
    End With
    Application.ScreenUpdating = 1
End Sub

Open in new window


Kris
0
 
LVL 11

Author Comment

by:bsharath
ID: 38766349
0

Featured Post

Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question