Code to Delete, Add and Move Worksheet not working when creating a summary in Excel 2010 2

[JasonEnsor]

Hi Guys,

I've been playing around with some code and can't quite figure out what i am doing wrong. My code SHOULD prompt the user for a search string, from that it will check if a worksheet exists, if so it will delete it (so all data is gone). it will create a new sheet named from the search string. it should then move that sheet to the end of the workbook. For every occurence of the search string in sheet1 it should copy that row in to the newly created sheet.

I am using this as a temporary summary of data on a user.

If i remove the code to add/delete a new sheet and move it to the end the whole thing works, creating a summary on sheet 2.

Option Explicit

Sub SearchString()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer
   Dim User_SearchString As String
   
   Dim sh As Worksheet
   
   On Error GoTo Err_Execute
   
   LSearchRow = 2
   LCopyToRow = 2
   
   User_SearchString = InputBox("Enter Search String")

   Set sh = Worksheets(User_SearchString)
   If (WorksheetExists(User_SearchString)) = True Then
      Application.DisplayAlerts = True

        sh.Delete
   End If

   Worksheets.Add.Name = User_SearchString
   Sheets(User_SearchString).Move AFTER:=Sheets(Sheets.Count)
   Application.DisplayAlerts = True
   
   While Len(Range("A" & CStr(LSearchRow)).Value) > 0
         
      If (StrComp(Range("B" & CStr(LSearchRow)).Value, User_SearchString, vbTextCompare) = 0) Then
         
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy
         
         Sheets(User_SearchString).Select
         
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         
         ActiveSheet.Paste

         LCopyToRow = LCopyToRow + 1
         
         Sheets("Sheet1").Select

      End If
      
      LSearchRow = LSearchRow + 1
   Wend
   
   Application.CutCopyMode = False
   Range("A3").Select
   
   MsgBox "All Complete"
   Exit Sub
   
Err_Execute:
   MsgBox "Error"
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean

On Error Resume Next

WorksheetExists = (Sheets(WorksheetName).Name <> "")

On Error GoTo 0

End Function

Any thoughts and ideas would be appreciated

Regards

J.

 

[combo]

The sh may try to refer to a sheet that does not exist. Put the variable setting to the place where you are sure that you can do this:

If (WorksheetExists(User_SearchString)) = True Then
    Application.DisplayAlerts = True
    Set sh = Worksheets(User_SearchString)
    sh.Delete
End If

If it's the only place you test if sheet exist, you can simplify your code:

On Error Resume Next
Application.DisplayAlerts = True
Worksheets(User_SearchString).Delete
On Error GoTo 0

Analyse the Application.DisplayAlerts setting. It's inconsistent, if it's always true, there is no need to code this. If no, the condition [tt]If (WorksheetExists(User_SearchString)) = True Then[/tt] will change setting for the rest of code only if sheet exists.

combo

 

[SkipVought]

I'd do this

   User_SearchString = InputBox("Enter Search String")

   For Each sh In ThisWorkbook.Worksheets
      With sh
         If .Name = User_SearchString Then
            .Delete
            Exit For
         End If
      End With
   Next

   With Worksheets.Add(User_SearchString)
        .Name = User_SearchString
        .Move AFTER:=Sheets(Sheets.Count)
        Application.DisplayAlerts = True

'now find and copy stuff

   End With

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[JasonEnsor]

Hi Combo,

Thanks for the help, the Application.DisplayAlerts were due to me testing bits of code and deleting bits and the whole thing was in a mess. Your advice worked brilliantly. Took me a few attempts to get the data to copy over to the new sheet (realized after creating the new sheet i hadn't selected the original sheet with data in).

I really don't know what i would do without this forum and guys like you who have been willing to help me as i have slowly learned VBA.

Thanks again

J.

 

[JasonEnsor]

Hi Skip,

Thank you for the alternative method. I will test it out now, as stated in the message above you guys have really helped me when it comes to my VBA and i am very thankful

Regards

J.