Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
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
?
393 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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

NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

Question has a verified solution.

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

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
My attempt to use PowerShell and other great resources found online to simplify the deployment of Office 365 ProPlus client components to any workstation that needs it, regardless of existing Office components that may be needing attention.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

618 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