Updating my workbook

I have created a Workbook that is used in various different computers. Sometimes I add features to it and I would like to easily update it. The idea is whenever I have a new version of it, I take it to a new computer, save in a temp file and copy the sheets where the data is stored.

Based on the answers I have edit my first draft to: (I didn't know that both workbooks needed to be opened at the same time)

Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim ws As Worksheet
Dim wb As Workbook
Dim wn As Workbook
Set wn = Workbooks("Reception")
Set wb = Workbooks("Reception2")

With wb
  .Sheets("Pass").Range("A1") = "flh"

  For Each ws In .Worksheets
    Select Case .Name
            Case "Formularios", "Coordenador", "LookupList", "Pass"
               'Do nothing
            Case Else
                ws.Delete
    End Select
  Next ws
End With

With wn
  For Each sh In .Worksheets
    Select Case .Name
        Case "Formularios", "Coordenador", "LookupList", "Pass"
        'Do nothing
        Case Else
            sh.Copy After:=wb.Sheets(wb.Sheets.Count)
    End Select
  Next sh
End With

End Sub

Case at moment is not working and macro deletes every sheet no matter the name

Thank you all for the feedback

Upvotes: 0

Views: 60

Answers (3)

With some more googling I was able to craft the code that I wanted in the end. Here is the answer for the curious or for other people looking to do the same:

Private Sub CommandButton1_Click() 
Dim sh As Worksheet
Dim ws As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim j As Long
Dim Rng As Range
Dim wb As Workbook
Dim wn As Workbook
Set wn = Workbooks("Reception")
Set wb = Workbooks("Reception2")

With wb
  .Sheets("Pass").Range("A1") = "flh"

  For Each ws In .Worksheets
    Select Case ws.Name
            Case "Formularios"
                'Do nothing
            Case "Coordenador"
                'Do nothing
            Case "LookupList"
                'Do nothing
            Case "Pass"
                'Do nothing
            Case Else
                 With ws
                    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
                    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                    Set Rng = .Range(.Cells(2, 1), .Cells(LastRow, LastCol))
                    Rng.ClearContents
                End With
    End Select
  Next ws
End With

With wn
  For Each sh In .Worksheets
    Select Case sh.Name
            Case "Formularios"
                'Do nothing
            Case "Coordenador"
                'Do nothing
            Case "LookupList"
                'Do nothing
            Case "Pass"
                'Do nothing
            Case Else
                For j = 1 To wb.Sheets.Count
                    If sh.Name = wb.Worksheets(j).Name Then
                        On Error Resume Next
                            sh.Range("A:J").Copy wb.Worksheets(j).Range("A1")
                    End If
                Next j
    End Select
  Next sh
End With
  Application.CutCopyMode = False
End Sub

Thanks to @Darren Bartrup-Cook for the help.

Upvotes: 0

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19722

You can find the temp folder by using Environ("temp"), but from your code I'm not sure this is the folder you're using.

This code has a couple of functions to check if the workbook exists and is already open. One other bit of code I'd add is to disable any code in Reception.xlsm from firing when it's opened.

Public Sub MyProcedure()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim wn As Workbook

    Dim Rec1Path As String
    Dim Rec2Path As String

    Rec1Path = "c:\save\Reception.xlsm"
    Rec2Path = "c:\temp\Reception2.xlsm"

    'Open or set a reference to Reception.xlsm.
    If WorkBookExists(Rec1Path) Then
        If WorkBookIsOpen(Rec1Path) Then
            'Don't need path for open workbook, just name.
            'InStrRev finds last occurrence of "\" (same as InStr, but in Reverse).
            Set wn = Workbooks(Mid(Rec1Path, InStrRev(Rec1Path, "\") + 1))
        Else
            Set wn = Workbooks.Open(Rec1Path)
        End If
    End If

    'Open or set a reference to Reception2.xlsm.
    If WorkBookExists(Rec2Path) Then
        If WorkBookIsOpen(Rec2Path) Then
            Set wb = Workbooks(Mid(Rec2Path, InStrRev(Rec2Path, "\") + 1))
        Else
            Set wb = Workbooks.Open(Rec2Path)
        End If
    End If

    With wb
        .Worksheets("Pass").Range("A1") = "flh"

        For Each ws In .Worksheets
            Select Case .Name
                Case "Formularios", "Coordenador", "LookupList", "Pass"
                    'Do nothing
                Case Else
                    'You don't really need the count of worksheets if you can guarantee
                    'you're not going to try and delete the last remaining sheet.
                    If .Worksheets.Count > 1 Then
                        Application.DisplayAlerts = False
                        ws.Delete
                        Application.DisplayAlerts = True
                    End If
            End Select
        Next ws
    End With

    With wn
        'Re-using the ws variable.
        For Each ws In .Worksheets
            Select Case .Name
                Case "Formularios", "Coordenador", "LookupList", "Pass"
                    'Do nothing
                Case Else
                    ws.Copy After:=wb.Sheets(wb.Sheets.Count)
            End Select
        Next ws
    End With

End Sub

Public Function WorkBookExists(sPath As String) As Boolean
    WorkBookExists = Dir(sPath) <> ""
End Function

Public Function WorkBookIsOpen(FullFilePath As String) As Boolean

    Dim ff As Long

    On Error Resume Next

    ff = FreeFile()
    Open FullFilePath For Input Lock Read As #ff
    Close ff
    WorkBookIsOpen = (Err.Number <> 0)

    On Error GoTo 0

End Function

Upvotes: 1

Xabier
Xabier

Reputation: 7735

Is the workbook open when you try to 'SET' it? If not you will need to open it as such:

Dim wb As Workbook
Set wb = Workbooks.Open("c:\temp\Reception.xlsm")

Upvotes: 0

Related Questions