[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 400
  • Last Modified:

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

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
bsharath
Asked:
bsharath
  • 4
  • 4
1 Solution
 
krishnakrkcCommented:
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
 
bsharathAuthor Commented:
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
 
krishnakrkcCommented:
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
Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

 
bsharathAuthor Commented:
Yes i want the exact match
What does the above change do?
0
 
krishnakrkcCommented:
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
 
bsharathAuthor Commented:
If the URl has a start and end space it ignores

Can this be dealt?
0
 
krishnakrkcCommented:
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

Featured Post

Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now