yoadle
yoadle

Reputation: 188

VBA command button add worksheet avoid duplication name

I created a button that will add a new worksheet("report") and extract some data from the original worksheet("Data") however when the new worksheet is added. I found that it is not really user friendly because it can only generate a new report one time. When I press the button when the report is added/ created, it will give me an error like "worksheet name duplicated". Also, I don't want my user manually delete the old one to generate a new one. I am not sure how it will work in my code. On the other hand, I am not sure using a delete method to solve this problem or adding a new worksheet with a different name that every time they press the generation button like report 1, report 2 , report 3....... If I want to add one of those function what should i add in my original code ?

Private Sub CommandButton3_Click()

Dim rng As Range
Dim ss As Range, cel As Range
Dim yesno As Range
Dim lastrow As Long    //looking for the last row of the data
Dim tws As Worksheet
Dim tlr, i&

Set wks = Sheets("Data")
With wks
lastrow = .Range("A3").End(xlDown).Row

Set yesno = .Range("AX3:AX" & lastrow)
Set tws = Worksheets.Add(after:=Sheets(Worksheets.Count))
tws.Name = ("report")
//fetch the first row as the title 
Set rng = Union(.Range("B1"), .Range("F1"), .Range("G1"),
.Range("H1"),.Range("N1"), .Range("O1"), .Range("Q1"), .Range("U1"),
.Range("W1"))
rng.Copy tws.Range("A1")

//fetec the data with condition
For Each ss In yesno
If LCase(ss.Cells.Value) = "Yes" And 
LCase(ss.Cells.Offset(0, -31).Value) = "Trigger" And
LCase(ss.Cells.Offset(0, -47).Value) = "Trigger" Then
Set rng = Union(.Range("B" & ss.Row), .Range("F" & ss.Row),
.Range("G" & ss.Row), .Range("H" & ss.Row), .Range("N" & ss.Row),
.Range("O"&   ss.Row), .Range("Q" & ss.Row), .Range("U" & ss.Row),
.Range("W" & ss.Row))
tlr = tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1).Row
rng.Copy tws.Cells(tlr, "A")
ElseIf LCase(ss.Cells.Value) = "No" Then
End If
Next

End With









End Sub

Upvotes: 0

Views: 152

Answers (3)

logicOnAbstractions
logicOnAbstractions

Reputation: 2580

Well I would STRONGLY recommand to NOT work with the sheetname (e.g. what shows up in Excel), but instead work with the codename. The sheetname the user can change just by clicking on the tab. The Codename you can only change in VBA.

Just change the "Sheet1", "Sheet2", etc. to something that will help you see what's what. I like to put my codenam in caps so it's clear what I'm using. In your case, something like this. If you don't see the bottom pane on the left, press "F4" after selecting any of the sheets. THis is in your VBA editor, left side, next to "(Name)" it should say SheetX, replace by "REPORT":

enter image description here

Now, you may not want to refactor all your code - so I've slightly edited so you can still use it. The only changes (appart from using the Codename as shown in the screenshot) are between the ################# sections:

Dim rng As Range
Dim ss As Range, cel As Range
Dim yesno As Range
Dim lastrow As Long
Dim tws As Worksheet
Dim tlr, i&

Set wks = Sheets("Data")
With wks
   lastrow = .Range("A3").End(xlDown).Row
   Set yesno = .Range("AX3:AX" & lastrow)

   '########### Don't need that anymore #############
'   Set tws = Worksheets.Add(after:=Sheets(Worksheets.Count))
'   tws.Name = ("report")
   '########### We replace by that below #############  
   REPORT.Cells.Clear
   Set tws = REPORT
   '################### All the rest stays the same ##########

   'fetch the first row as the title
   Set rng = Union(.Range("B1"), .Range("F1"), .Range("G1"), _
   .Range("H1"), .Range("N1"), .Range("O1"), .Range("Q1"), .Range("U1"), _
   .Range("W1"))
   rng.Copy tws.Range("A1")

   '//fetec the data with condition
   For Each ss In yesno
   If LCase(ss.Cells.Value) = "Yes" And
   LCase(ss.Cells.Offset(0, -31).Value) = "Trigger" And
   LCase(ss.Cells.Offset(0, -47).Value) = "Trigger" Then
   Set rng = Union(.Range("B" & ss.Row), .Range("F" & ss.Row),
   .Range("G" & ss.Row), .Range("H" & ss.Row), .Range("N" & ss.Row),
   .Range("O"&   ss.Row), .Range("Q" & ss.Row), .Range("U" & ss.Row),
   .Range("W" & ss.Row))
   tlr = tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1).Row
   rng.Copy tws.Cells(tlr, "A")
   ElseIf LCase(ss.Cells.Value) = "No" Then
   End If
   Next

End With

So in essence, I'm just clearing the existing report sheet (instead of deleting), then reproducing the report in that sheet.

Upvotes: 1

Dirk Reichel
Dirk Reichel

Reputation: 7979

This should fit all your needs in a fast way:

Private Sub CommandButton3_Click()
  Dim rng As Range, ss As Range
  Dim tws As Worksheet
  Dim chkRng As Variant
  Dim a(100) As Boolean
  With Sheets("Data")
    For Each tws In Sheets
      If InStr(1, tws.Name, "report", 1) = 1 Then
        If Len(tws.Name) = 6 Then
          a(0) = True
        Else
          If isnumerc(Mid(tws.Name, 7)) Then a(CByte(Mid(tws.Name, 7))) = True
        End If
      End If
    Next ws
    Set tws = Worksheets.Add(, Sheets(Worksheets.Count))
    'get the first possible name
    If Application.Match(False, a, 0) = 1 Then tws.Name = "Report" Else tws.Name = "Report " & Application.Match(False, a, 0) - 1
    'fetch the first row as the title
    Union(.Range("B1"), .Range("F1:H1"), .Range("N1:O1"), .Range("Q1"), .Range("U1"), .Range("W1")).Copy tws.Range("A1")
    'fetch the data with condition
    chkRng = .Range("A1:AX" & .Range("A3").End(xlDown).Row).Value
    For a = 3 To .Range("A3").End(xlDown).Row
      If LCase(chkRng(a, 3)) = "trigger" And LCase(chkRng(a, 19)) = "trigger" And LCase(chkRng(a, 50)) = "yes" Then
        With .Rows(a)
          If rng Is Nothing Then
            Set rng = Union(.Columns("B"), .Columns("F:H"), .Columns("N:O"), .Columns("Q"), .Columns("U"), .Columns("W"))
          Else
            Set rng = Union(rng, .Columns("B"), .Columns("F:H"), .Columns("N:O"), .Columns("Q"), .Columns("U"), .Columns("W"))
          End If
        End With
      End If
    Next
    rng.Copy tws.Cells(tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1).Row, "A")
  End With
End Sub

I have at least 1 question: how can LCase(ss.Cells.Value) = "Yes" ever be true? Your "Yes" contains uppercase... so does your check for "Trigger"...
However, if you have any questions, just ask :)

Upvotes: 3

Sergey Ryabov
Sergey Ryabov

Reputation: 656

That should help you. I declared an array in which we store all reports' numbers. Then it finds the maximum value of the array and sets it as a next report number. If there is no reports, it creates "report1". Please ask if you have any questions regarding the code.

Private Sub CommandButton3_Click()

Dim rng As Range
Dim ss As Range, cel As Range
Dim yesno As Range
Dim lastrow As Long
Dim tws As Worksheet
Dim tlr, i&
Dim ws As Worksheet 'we will use it for a loop
Dim reportNum() As Long 'it's an array to gather all reports' numbers
ReDim reportNum(1 To 1) As Long
Dim reportExists As Long


Set wks = Sheets("Data")
With wks
lastrow = .Range("A3").End(xlDown).Row

Set yesno = .Range("AX3:AX" & lastrow)
Set tws = Worksheets.Add(after:=Sheets(Worksheets.Count))

'A loop through each worksheet to check existence of "report" sheet. If so, it determines number of the last report
For Each ws In Sheets
    If Left(ws.Name, 6) = "report" Then
        reportExists = True
        reportNum(UBound(reportNum)) = Mid(ws.Name, 7)
        ReDim Preserve reportNum(1 To UBound(reportNum) + 1) As Long
    End If
Next ws

If reportExists = True Then
    nextReport = Application.WorksheetFunction.Max(reportNum()) + 1
    tws.Name = "report" & nextReport
Else
    tws.Name = "report1"
End If

Set rng = Union(.Range("B1"), .Range("F1"), .Range("G1"), .Range("H1"), .Range("N1"), .Range("O1"), .Range("Q1"), .Range("U1"), .Range("W1"))
rng.Copy tws.Range("A1")

For Each ss In yesno
If LCase(ss.Cells.Value) = "Yes" And LCase(ss.Cells.Offset(0, -31).Value) = "Trigger" And LCase(ss.Cells.Offset(0, -47).Value) = "Trigger" Then
Set rng = Union(.Range("B" & ss.Row), .Range("F" & ss.Row), .Range("G" & ss.Row), .Range("H" & ss.Row), .Range("N" & ss.Row), .Range("O" & ss.Row), .Range("Q" & ss.Row), .Range("U" & ss.Row), .Range("W" & ss.Row))
tlr = tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1).Row
rng.Copy tws.Cells(tlr, "A")
ElseIf LCase(ss.Cells.Value) = "No" Then
End If
Next

End With

End Sub

Upvotes: 2

Related Questions