troubleshooting Question

Help in modifying a VBA code.

Avatar of Olympia275
Olympia275Flag for United States of America asked on
Microsoft ExcelVB Script
14 Comments1 Solution459 ViewsLast Modified:
Hello experts,

I have this code below which is searching for multiple strings, defined with the object "r" and creates a new Sheet for each category. The problem is that my data source keeps on updating in a loop and I keep on rerunning this code, which consequently tries to re-create the same sheets over and over.  So I need to add the following.

before creating a new sheet it should check whether the sheet already exists, and if so add the data to the bottom of it, if not create a new sheet.

I would also like to add a function, which will run every time at the end of this code, to delete the duplicates from every sheet separately, defined with the object "r".

Thank you.
Sub findData()

Dim f As Range, fa As String, i As Long, r As Range, ws As Worksheet
Dim src As Worksheet, dst As Worksheet

Set src = Sheets("sheet2") 'sheet to be searched, change as required

i = 1

For Each r In Sheets("Sheet3").Range("A1", Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp))
        Set f = src.Cells.Find(What:=r.Value, after:=src.Cells(1), LookIn:=xlFormulas, _
                               LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                               MatchCase:=False, SearchFormat:=False)
        If Not f Is Nothing Then
            Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
            ws.Name = r
            fa = f.Address
                If Len(f.Value) < 80 Then
                    ws.Range("A" & Rows.Count).End(xlUp)(2) = f.Value
                    i = i + 1
                End If
                Set f = src.Cells.FindNext(f)
            Loop Until fa = f.Address
        End If
        fa = ""

Next r

End Sub
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 14 Comments.
Join the Community
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 14 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