Check if sheet name existing before copy - Excel VBA

CakzPrimz

Board Regular
Joined
Oct 6, 2017
Messages
57
Hi Guys,

I am trying to copy from another workbooks based on criteria of a textbox in a userform. If I select a certain value from the textbox then it will create a new sheet with name as criteria.

If the sheet name is not exist:
- it will create/insert a sheet name, the same name with of textbox
- copy from another workbook/worksheet to this new sheet

if the sheet name is exist:
- it will not create/insert a new sheet
- copy from another workbook/worksheet to existing sheet, under existing data

VBA Code:
Sub SystemDes_AXREP()
    Application.ScreenUpdating = False
    
    Dim thiswb As Workbook
    Dim otherwb As Workbook
    Dim dynaws As Worksheet
    Dim LRow As Long

    Set thiswb = ActiveWorkbook
    Set dynaws = Sheets.Add
    
    Workbooks.Open Filename:="\\psssvc005\P_Tangguh_Papua\12.COMMON_FOLDER\Andrea\Prima\AXREP.csv"
    Set otherwb = ActiveWorkbook
    LRow = Cells(Rows.Count, 6).End(xlUp).Row
    Range("C3").Value = Frm_SystemDescription.SYSTEM_NUMBER.Caption
    dynaws.Name = thiswb.Sheets("Menu").Range("C3").Value
    Crit = thiswb.Sheets("Menu").Range("C3").Value
    
    If dynaws.Cells(1, 1).Value = vbNullString Then
    dynaws.Range("A1000000").End(xlUp).Offset(0, 0).Value = "AXREP"
    dynaws.Range("A1000000").End(xlUp).Offset(0, 1).FormulaR1C1 = "=TODAY()"
    Else
    dynaws.Range("A1000000").End(xlUp).Offset(2, 0).Value = "AXREP"
    dynaws.Range("A1000000").End(xlUp).Offset(0, 1).FormulaR1C1 = "=TODAY()"
    End If
    
    dynaws.Range("A1000000").End(xlUp).Offset(0, 1).Value = dynaws.Range("A1000000").End(xlUp).Offset(0, 1).Value
    otherwb.Sheets("AXREP").Range("$A$1:$AV$1").AutoFilter Field:=3, Criteria1:="=*" & Crit & "*", Operator:=xlFilterValues
    otherwb.Sheets("AXREP").Range("A1:AV" & LRow).SpecialCells(xlCellTypeVisible).Copy
    dynaws.Range("A1000000").End(xlUp).Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
    otherwb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True

End Sub

The code above works, but if a sheet name is existing, it is copying to a new sheet.
How to add the code so it can identify whether a sheet is existing or not, before creating a new sheet?


Thanks so much
prima - Indonesia
 

Attachments

  • prima_UserForm.gif
    prima_UserForm.gif
    55.5 KB · Views: 6

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
An Idea
VBA Code:
 With ActiveWorkbook
      If Not Evaluate("ISREF('" & "What ever" & "'!A1)") Then .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "What ever"
    End With
 
Upvote 0
Dear mohadin,

Thank you for your help. Would please explain further what is "What ever" means after ISREF. And for your additional information the value of sheet name is at Range C3. And where I should place your code in mine?

Thank you
 
Upvote 0
So it should
VBA Code:
With ActiveWorkbook
      If Not Evaluate("ISREF('" & Range("C3").Value & "'!A1)") Then .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name =  Range("C3").Value
    End With
To test the existence of the sheet by reading a value form a cell or range
the you should place this bit after you open the file
Hope it is clear for you
 
Upvote 0
May be
VBA Code:
Sub SystemDes_AXREP()
    Application.ScreenUpdating = False
    
    Dim thiswb As Workbook
    Dim otherwb As Workbook
    Dim dynaws As Worksheet
    Dim LRow As Long

    Set thiswb = ActiveWorkbook
    
    Range("C3").Value = Frm_SystemDescription.SYSTEM_NUMBER.Caption
     Crit = thiswb.Sheets("Menu").Range("C3").Value
     With thiswb
        If Not Evaluate("ISREF('" & Crit & "'!A1)") Then .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = Crit
    End With
    Set dynaws = ActiveSheet
    Workbooks.Open Filename:="\\psssvc005\P_Tangguh_Papua\12.COMMON_FOLDER\Andrea\Prima\AXREP.csv"
    Set otherwb = ActiveWorkbook
    LRow = Cells(Rows.Count, 6).End(xlUp).Row
    
    If dynaws.Cells(1, 1).Value = vbNullString Then
    dynaws.Range("A1000000").End(xlUp).Offset(0, 0).Value = "AXREP"
    dynaws.Range("A1000000").End(xlUp).Offset(0, 1).FormulaR1C1 = "=TODAY()"
    Else
    dynaws.Range("A1000000").End(xlUp).Offset(2, 0).Value = "AXREP"
    dynaws.Range("A1000000").End(xlUp).Offset(0, 1).FormulaR1C1 = "=TODAY()"
    End If
    
    dynaws.Range("A1000000").End(xlUp).Offset(0, 1).Value = dynaws.Range("A1000000").End(xlUp).Offset(0, 1).Value
    otherwb.Sheets("AXREP").Range("$A$1:$AV$1").AutoFilter Field:=3, Criteria1:="=*" & Crit & "*", Operator:=xlFilterValues
    otherwb.Sheets("AXREP").Range("A1:AV" & LRow).SpecialCells(xlCellTypeVisible).Copy
    dynaws.Range("A1000000").End(xlUp).Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
    otherwb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Solution
May be
VBA Code:
Sub SystemDes_AXREP()
    Application.ScreenUpdating = False
   
    Dim thiswb As Workbook
    Dim otherwb As Workbook
    Dim dynaws As Worksheet
    Dim LRow As Long

    Set thiswb = ActiveWorkbook
   
    Range("C3").Value = Frm_SystemDescription.SYSTEM_NUMBER.Caption
     Crit = thiswb.Sheets("Menu").Range("C3").Value
     With thiswb
        If Not Evaluate("ISREF('" & Crit & "'!A1)") Then .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = Crit
    End With
    Set dynaws = ActiveSheet
    Workbooks.Open Filename:="\\psssvc005\P_Tangguh_Papua\12.COMMON_FOLDER\Andrea\Prima\AXREP.csv"
    Set otherwb = ActiveWorkbook
    LRow = Cells(Rows.Count, 6).End(xlUp).Row
   
    If dynaws.Cells(1, 1).Value = vbNullString Then
    dynaws.Range("A1000000").End(xlUp).Offset(0, 0).Value = "AXREP"
    dynaws.Range("A1000000").End(xlUp).Offset(0, 1).FormulaR1C1 = "=TODAY()"
    Else
    dynaws.Range("A1000000").End(xlUp).Offset(2, 0).Value = "AXREP"
    dynaws.Range("A1000000").End(xlUp).Offset(0, 1).FormulaR1C1 = "=TODAY()"
    End If
   
    dynaws.Range("A1000000").End(xlUp).Offset(0, 1).Value = dynaws.Range("A1000000").End(xlUp).Offset(0, 1).Value
    otherwb.Sheets("AXREP").Range("$A$1:$AV$1").AutoFilter Field:=3, Criteria1:="=*" & Crit & "*", Operator:=xlFilterValues
    otherwb.Sheets("AXREP").Range("A1:AV" & LRow).SpecialCells(xlCellTypeVisible).Copy
    dynaws.Range("A1000000").End(xlUp).Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
    otherwb.Close SaveChanges:=False
   
    Application.ScreenUpdating = True

End Sub
Dear mohadin,

Thanks for your assistance and helping hands,

Based on your suggestion, I finally go with the code below, and it works.
Again, thank you so much.
Problem solved !
Thank you mohadin and thank you MrExcel


VBA Code:
Sub Vedo_La_Luce1()
    'I see the light
    'System Description - AXREP.csv
    'Developed by Prima Satria - Indonesia
    '+62 852 7477 1847

    Dim thiswb As Workbook
    Dim otherwb As Workbook
    Dim dynaws As Worksheet
    Dim LRow As Long
    
    Set thiswb = ActiveWorkbook
    
    Sheet3.Range("C3").Value = Frm_SystemDescription.System_Number.Caption

    Dim sh As Worksheet, shNam As String
    If IsEmpty(Sheets("Menu").Range("C3")) Then Exit Sub
    shNam = Sheets("Menu").Range("C3").Value
    If SheetExists(ActiveWorkbook.Name, shNam) Then
        Sheets(shNam).Select
        With Sheets(shNam)
            If .Cells(1, 1).Value = vbNullString Then
                .Range("A1000000").End(xlUp).Offset(0, 0).Value = "AXREP"
                .Range("A1000000").End(xlUp).Offset(0, 1).Formula = "=TODAY()"
                .Range("A1000000").End(xlUp).Offset(0, 1).Value = .Range("A1000000").End(xlUp).Offset(0, 1).Value
                .Range("A1000000").End(xlUp).Offset(0, 2).Value = Frm_SystemDescription.List_Description.Text
            Else
                .Range("A1000000").End(xlUp).Offset(2, 0).Value = "AXREP"
                .Range("A1000000").End(xlUp).Offset(0, 1).Formula = "=TODAY()"
                .Range("A1000000").End(xlUp).Offset(0, 1).Value = .Range("A1000000").End(xlUp).Offset(0, 1).Value
                .Range("A1000000").End(xlUp).Offset(0, 2).Value = Frm_SystemDescription.List_Description.Text
            End If
        End With
        
        'Workbooks.Open Filename:="C:\Users\pssco2412\Downloads\AXREP.csv"
        'Workbooks.Open Filename:="\\psssvc005\P_Tangguh_Papua\12.COMMON_FOLDER\Andrea\Prima\AXREP.csv"
        Workbooks.Open Filename:="P:\CSTS_SHARE\4.CONSTRUCTION\24. MECHANICAL COMPLETION\3.PUNCHLIST\20. PRIMA\AXREP.xlsb"
        Set otherwb = ActiveWorkbook
        LRow = Cells(Rows.Count, 6).End(xlUp).Row
        Crit = thiswb.Sheets("Menu").Range("C3").Value
        
        otherwb.Sheets("AXREP").Range("$A$1:$BH$1").AutoFilter Field:=3, Criteria1:="=*" & Crit & "*", Operator:=xlAnd
        otherwb.Sheets("AXREP").Range("$A$1:$BH$1").AutoFilter Field:=14, Criteria1:="<>COMPLETED"
        otherwb.Sheets("AXREP").Range("A1:BH" & LRow).SpecialCells(xlCellTypeVisible).Copy
        thiswb.Activate
        Sheets(shNam).Select
        Sheets(shNam).Range("A1000000").End(xlUp).Offset(1, 0).PasteSpecial
        Application.CutCopyMode = False
        otherwb.Close SaveChanges:=False
        
    Else
        Worksheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = shNam
        
                
        'Workbooks.Open Filename:="C:\Users\pssco2412\Downloads\AXREP.csv"
        'Workbooks.Open Filename:="\\psssvc005\P_Tangguh_Papua\12.COMMON_FOLDER\Andrea\Prima\AXREP.csv"
        Workbooks.Open Filename:="P:\CSTS_SHARE\4.CONSTRUCTION\24. MECHANICAL COMPLETION\3.PUNCHLIST\20. PRIMA\AXREP.xlsb"
        Set otherwb = ActiveWorkbook
        LRow = Cells(Rows.Count, 6).End(xlUp).Row
        Crit = thiswb.Sheets("Menu").Range("C3").Value
        
        otherwb.Sheets("AXREP").Range("$A$1:$BH$1").AutoFilter Field:=3, Criteria1:="=*" & Crit & "*", Operator:=xlAnd
        otherwb.Sheets("AXREP").Range("$A$1:$BH$1").AutoFilter Field:=14, Criteria1:="<>COMPLETED"
        otherwb.Sheets("AXREP").Range("A1:BH" & LRow).SpecialCells(xlCellTypeVisible).Copy
        thiswb.Activate
        Sheets(shNam).Select
        
        With Sheets(shNam)
            If .Cells(1, 1).Value = vbNullString Then
                .Range("A1000000").End(xlUp).Offset(0, 0).Value = "AXREP"
                .Range("A1000000").End(xlUp).Offset(0, 1).Formula = "=TODAY()"
                .Range("A1000000").End(xlUp).Offset(0, 1).Value = .Range("A1000000").End(xlUp).Offset(0, 1).Value
                .Range("A1000000").End(xlUp).Offset(0, 2).Value = Frm_SystemDescription.List_Description.Text
            Else
                .Range("A1000000").End(xlUp).Offset(2, 0).Value = "AXREP"
                .Range("A1000000").End(xlUp).Offset(0, 1).Formula = "=TODAY()"
                .Range("A1000000").End(xlUp).Offset(0, 1).Value = .Range("A1000000").End(xlUp).Offset(0, 1).Value
                .Range("A1000000").End(xlUp).Offset(0, 2).Value = Frm_SystemDescription.List_Description.Text
            End If
        End With
                
        Sheets(shNam).Range("A1000000").End(xlUp).Offset(1, 0).PasteSpecial
        
        Application.CutCopyMode = False
        otherwb.Close SaveChanges:=False
    End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,920
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top