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
355 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
  • 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
 
LVL 11

Author Comment

by:bsharath
ID: 38766283
Yes i want the exact match
What does the above change do?
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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 500 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

867 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now