troubleshooting Question

Compair Data and delete unmatched

Avatar of keilah
keilahFlag for Netherlands asked on
VB Script
2 Comments1 Solution257 ViewsLast Modified:
Hi. have the following code need not working at the moment, need some correcting.

I need to match col b from the master sheet which is "fees", with the second worksheet "ForcastData" col c and delete any data that does bot match.

Need to look as at the following worksheet for this example in the uploaded worksheet. "fees" and "ForcastData"

Here is the file locaation.

Your file has successfully been uploaded!
To download the file, you must be logged into EE-Stuff. Here are two pages that will display your file, if logged in:

View all files for Question ID: 19634478
https://filedb.experts-exchange.com/incoming/ee-stuff/4260-Book1.ziphttps://filedb.experts-exchange.com/incoming/ee-stuff/4292-Book22.zip
https://filedb.experts-exchange.com/incoming/ee-stuff/4315-Copy-of-Test-Works-sheet-JanFin.zip
 

Direct link to your file
https://filedb.experts-exchange.com/incoming/ee-stuff/4315-Copy-of-Test-Works-sheet-JanFin.zip 

so if barclays 1+2 is in row 6 col b in "fees" worksheet (masterworksheet), however this corresponding enter could be in any row (C11:C186) but well always be in column c (fixed), if it is there keep the data as matched item.   Any enters that do not match against the masterworksheet "fees" are deleted as unmatched items from worksheet "ForcastData".

here is the code............

Sub CompareData()
Dim ws1 As Worksheet, ws2 As Worksheet, fndval As Variant, vcol As Variant, icol As Long, vcol1 As Variant, vcol2 As Variant
Dim fn As Variant, rng As Range, cel As Range, frg As Range, delrng As Range, addr As String, i As Long, j As Long

Application.ScreenUpdating = False

Set ws1 = ActiveSheet
Set ws2 = Worksheets("ForcastData")

vcol1 = Application.InputBox(Prompt:="Enter column in Main sheet", Title:="Main Sheet Column", Type:=2)
If IsError(vcol1) Or vcol1 = False Then
    MsgBox "Invalid column or input canceled.  Exiting routine.", vbInformation
    Exit Sub
End If

vcol2 = Application.InputBox(Prompt:="Enter column in 'Sheet2' sheet", Title:="Sheet2 Column", Type:=2)
If IsError(vcol1) Or vcol1 = False Then
    MsgBox "Invalid column or input canceled.  Exiting routine.", vbInformation
    Exit Sub
End If

For j = 1 To 2
    If j = 1 Then
        vcol = vcol1
    Else
        vcol = vcol2
    End If
   
    ' Check if column was entered as a number
    icol = 0
    On Error Resume Next
    icol = CLng(vcol)
    On Error GoTo 0
   
    If icol <> 0 Then
        vcol = icol
    Else
        ' Check if column entered was a valid string
        For i = 1 To Len(vcol)
            If Asc(Mid(vcol, i, 1)) < 65 Or Asc(Mid(vcol, i, 1)) > 122 Or (Asc(Mid(vcol, i, 1)) >= 91 And Asc(Mid(vcol, i, 1)) <= 96) Or i > 2 Then
                MsgBox "Invalid column entered.  Exiting routine.", vbInformation
                Exit Sub
            End If
        Next i
    End If
   
    If j = 1 Then
        vcol1 = vcol
    Else
        vcol2 = vcol
    End If
Next j

Set rng = Intersect(ws2.Columns(vcol2), ws2.UsedRange)

For Each cel In rng
    Set frg = Intersect(ws1.Columns(vcol1), ws1.UsedRange).Find(cel.Value, LookIn:=xlValues, LookAt:=xlWhole)
   
    If frg Is Nothing Then
        If Not delrng Is Nothing Then
            Set delrng = Union(delrng, cel)
        Else
            Set delrng = cel
        End If
    End If
Next cel

If Not delrng Is Nothing Then
    delrng.EntireRow.Delete
End If

Application.ScreenUpdating = True

End Sub

ASKER CERTIFIED SOLUTION
harfang

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 2 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 2 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros