Select Sheet from External Workbook

breynolds0431

Active Member
Joined
Feb 15, 2013
Messages
303
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hello. I have a userform where a user will select an external workbook that will then import the sheet to the current workbook. The issue that arises is when the external workbook has more than one sheet. So, my plan was to have another userform pop up when the external workbook's sheet count is greater than 1 that would allow the user to select the intended sheet.

I have this part in the import file userform:

VBA Code:
Dim wbThisWB As Workbook: Set wbThisWB = ThisWorkbook
Dim wbImportWB As Workbook
Dim strFullPath As String
Dim lngLastRow As Long
Dim lngLastCol As Long

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select the listing"
        .Filters.Add "Excel and CSV files", "*.csv; *.xls; *.xls*", 1
        .Show
        On Error Resume Next 
            strFullPath = .SelectedItems(1)
            If Err.Number <> 0 Then
                wbThisWB = Nothing

                Application.ScreenUpdating = True
                Exit Sub 'Error has occurred so quit
            End If
        On Error GoTo 0
    End With

Dim fileName As String
fileName = strFullPath

'Will check if report is already opened to avoid run-time error.
If IsFileOpen(fileName) = False Then
    Set wbImportWB = Workbooks.Open(strFullPath)
Else
    MsgBox "The CY listing is open on your computer. Please close and retry import.", vbInformation, "CY Listing Open"
    Me.lblCYProcess.Visible = False
    Application.ScreenUpdating = True
    Unload Me
    Exit Sub
End If

'sets workbook name to info tab in order for ufTabSelect to know ImportWB name

wbThisWB.Sheets("Info").Range("CYwbName").Value = wbImportWB.Name

Dim impSheet As Integer

'Checks to ensure there's only one sheet in ImportWB
If wbImportWB.Sheets.count > 1 Then
          ufTabSelect.Show
          ' add variable here
          impSheet = ufTabSelect.cboSheets.ListIndex
Else
          impSheet = 1
End If

'Checks if CY tab in wbThisWB already exists. If not, it will be created/added.
wbThisWB.Activate
Dim I, sheet_exists As Integer
    sheet_exists = 0
    For I = 1 To Sheets.count
       If Sheets(I).Visible = -1 Then
           If Sheets(I).Name = "CY" Then
                sheet_exists = 1
           End If
       End If
    Next
    
    If sheet_exists = 0 Then
        Sheets.Add(After:=Sheets(Sheets.count)).Name = "CY"
    Else
          On Error Resume Next
        Application.DisplayAlerts = False
        ThisWorkbook.Sheets("CY").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        Sheets.Add(After:=Sheets(Sheets.count)).Name = "CY"
    End If

wbThisWB.Sheets("CY").Select
    
On Error Resume Next
    With wbImportWB.Sheets(impSheet)
        lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lngLastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        If lngLastRow > 0 And lngLastCol > 0 Then
            Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol)).Copy wbThisWB.Sheets("CY").Cells(1, 1)
        End If
    End With
On Error GoTo 0
    
wbImportWB.Close False

End Sub

For the ufTabSelect, I have the following, where cboSheets is the combobox. The combobox properly lists out the ImportWB's sheets. And there's a Done button to unload the ufTabSelect (Me).

VBA Code:
Private Sub UserForm_Initialize()

With Me
          .StartUpPosition = 0
          .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
          .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
End With

Dim I As Long
Dim wbName As String: wbName = ThisWorkbook.Sheets("Info").Range("CYwbName")

Me.cboSheets.Clear

With Workbooks(wbName)
          For I = 1 To .Sheets.count
              Me.cboSheets.AddItem .Sheets(I).Name
          Next
          'Me.cboSheets.Value = ActiveSheet.Name
End With

End Sub

The problem is that the code from the first userform doesn't stop and wait for the user to select the sheets before going to wbImportWB.Close. So, what happens is the CY sheet is created, but it's obviously blank. I'm guessing it's reading impSheet as sheet index 0, which is odd that an error doesn't result. Not sure at this point. Any insightful tips would be greatly appreciated.
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Your aim is to import a worksheet from another workbook. I think it makes sense to copy this worksheet in its entirety instead of copying its data to an empty worksheet, unless you have a specific reason to do so. When using and accessing (members of) objects (like workbooks and worksheets), it is recommended to work with the objects themselves by storing references to these objects, rather than storing the names of those objects.

The problem is that the code from the first userform doesn't stop and wait for the user to select the sheets before going to wbImportWB.Close.
This sounds unlikely, since the userform ufTabSelect is modally put on the screen, so the calling code only continues after this userform is hidden or closed. Without seeing the rest of your code it's hard to determine what's going on. But it is precisely because you use userforms that you are flexible, because each userform is its own class, whose properties you can expand according to your own needs and insight. That way you don't have to use a worksheet range to store the name of the intended import worksheet, but you can simply exchange object variables.

I would suggest to post all your code of the userforms involved to make it more easy to resolve your issue.
 
Upvote 0
Your aim is to import a worksheet from another workbook. I think it makes sense to copy this worksheet in its entirety instead of copying its data to an empty worksheet, unless you have a specific reason to do so. When using and accessing (members of) objects (like workbooks and worksheets), it is recommended to work with the objects themselves by storing references to these objects, rather than storing the names of those objects.


This sounds unlikely, since the userform ufTabSelect is modally put on the screen, so the calling code only continues after this userform is hidden or closed. Without seeing the rest of your code it's hard to determine what's going on. But it is precisely because you use userforms that you are flexible, because each userform is its own class, whose properties you can expand according to your own needs and insight. That way you don't have to use a worksheet range to store the name of the intended import worksheet, but you can simply exchange object variables.

I would suggest to post all your code of the userforms involved to make it more easy to resolve your issue.

Thanks for the information and that's a good point to copy the entire sheet. I guess my concern was that the imported sheet could contain notes after the dataset that would not be needed and could potentially cause issues with the later, separate, process that will merge two imported lists together. But, with that said, the import process will import the data from an external workbook as long as there is only one sheet as it currently is written.

Here is the full CY (first listing) import code from the ufImport.

VBA Code:
Private Sub cbCY_Click()

Dim wbThisWB As Workbook: Set wbThisWB = ThisWorkbook
Dim wbImportWB As Workbook
Dim strFullPath As String
Dim lngLastRow As Long
Dim lngLastCol As Long

If Me.cboType.Value = "" Then
     MsgBox "Error!" & vbCrLf & vbCrLf & "You must select a review type to continue.", vbCritical, "Need Type"
     Exit Sub
End If

Application.ScreenUpdating = False

With wbThisWB.Sheets("Info")
          .Range("CYwbName").ClearContents
          .Range("CYwbSheetInt").ClearContents
End With

'Allows user to select the CY report with the File Picker dialog
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select the CY listing"
        .Filters.Add "Excel and CSV files", "*.csv; *.xls; *.xls*", 1
        .Show
        On Error Resume Next 'In case the user has clicked the cancel button
            strFullPath = .SelectedItems(1)
            If Err.Number <> 0 Then
                wbThisWB = Nothing

                Application.ScreenUpdating = True
                Exit Sub
            End If
        On Error GoTo 0
    End With

Me.lblCYProcess.Visible = True

Dim fileName As String
fileName = strFullPath

'Will check if report is already opened to avoid run-time error.
If IsFileOpen(fileName) = False Then
    Set wbImportWB = Workbooks.Open(strFullPath)
Else
    MsgBox "The CY listing is open on your computer. Please close and retry import.", vbInformation, "CY Listing Open"
    Me.lblCYProcess.Visible = False
    Application.ScreenUpdating = True
    Unload Me
    Exit Sub
End If

' Checks to see if first cell in import WB is blank
If wbImportWB.Sheets(1).Range("A1").Value = "" Then
     MsgBox "There's a problem with the listing. The first cell of the listing is blank. Please ensure the listing " & _
          "has one row of headers and that header row is on the first row.", vbCritical, "Listing Error"
     wbImportWB.Close savechanges:=False
          Me.lblCYProcess.Visible = False
     Application.ScreenUpdating = True
     Unload Me
     Exit Sub
End If

'Checks to ensure first row is not merged
Dim FirstMergeRow As Long
FirstMergeRow = Merge_Row(wbImportWB.Sheets(1).rows("1:1"))
If FirstMergeRow = 0 Then
Else
     MsgBox "The first row of the listing contains merged cells. Please update the listing to unmerge all cells, " & _
          "ensure each column has a heading, and then try importing again.", vbCritical, "Listing Error"
     wbImportWB.Close savechanges:=False
    Me.lblCYProcess.Visible = False
     Application.ScreenUpdating = True
     Unload Me
     Exit Sub
End If

'sets workbook name to info tab

wbThisWB.Sheets("Info").Range("CYwbName").Value = wbImportWB.Name

Dim impSheet As Integer

'Checks to ensure there's only one sheet
If wbImportWB.Sheets.count > 1 Then
          ufTabSelect.Show
          ' add variable here
          impSheet = ufTabSelect.cboSheets.ListIndex
Else
          impSheet = 1
End If

'Checks if CY tab already exists. If not, it will be created/added.
wbThisWB.Activate
Dim I, sheet_exists As Integer
    sheet_exists = 0
    For I = 1 To Sheets.count
       If Sheets(I).Visible = -1 Then
           If Sheets(I).Name = "CY" Then
                sheet_exists = 1
           End If
       End If
    Next
    
    If sheet_exists = 0 Then
        Sheets.Add(After:=Sheets(Sheets.count)).Name = "CY"
    Else
        On Error Resume Next
        Application.DisplayAlerts = False
        ThisWorkbook.Sheets("CY").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        Sheets.Add(After:=Sheets(Sheets.count)).Name = "CY"
    End If

wbThisWB.Sheets("CY").Select

'Imports selected sheet or only sheet
On Error Resume Next
    With wbImportWB.Sheets(impSheet)
        lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lngLastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        If lngLastRow > 0 And lngLastCol > 0 Then
            Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol)).Copy wbThisWB.Sheets("CY").Cells(1, 1)
        End If
    End With
On Error GoTo 0
    
wbImportWB.Close False

'add Listing and Seq #
Set wbThisWB = Nothing
Set wbImportWB = Nothing

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("CY")

ws.Columns("A:A").Select
Selection.Insert Shift:=xlToRight

ws.Range("A1").Value = "Listing Rec #"

Dim lrow As Long: lrow = Cells(rows.count, "B").End(xlUp).Row
Dim r As Long

For r = 2 To lrow
   Cells(r, 1) = "CY" & r - 1
Next r

On Error Resume Next
ActiveWorkbook.Worksheets("CY").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

Sheets(" ").Select
With Me
     .imgCYchk.Visible = True
     .lblCYProcess.Visible = False
End With
Application.ScreenUpdating = True

End Sub

Also, any insight you can provide on how to pass the import workbook (wbImportWB) variable to the ufTabSelect would be great information. I tend to write data to a sheet quite a bit for not knowing how to do this :oops:.
 
Upvote 0
In order to understand what your code does and also to determine what could be the cause of your issue, I have sliced your code a bit. Certain subtasks are now performed by separate procedures, often in the form of a function, i.e. the procedure returns a certain value or object when returning to the calling process. You already made use of this functionality in your original code, the IsFileOpen and Merge_Row functions are examples of this. The effect of slicing code this way is that the code is much more readable and maintainable. In addition, by using descriptive names there's no problem with omitting additional comments.

By the way, I couldn't reproduce your problem. That said, I also revised the code of the userform called ufTabSelect in its entirety. Note that this userform is extended with a custom property named WorksheetChosenByUser. In this context it's essential that the userform is loaded into memory by "NEW-ing" it like in the code snippet below (instead of using the userform's default instance).

Code snippet of function GetSheetFromOtherWorkbook:
VBA Code:
    Dim MyDialog    As ufTabSelect
    Set MyDialog = New ufTabSelect
    Set GetSheetFromOtherWorkbook = MyDialog.WorksheetChosenByUser(argWb)
    Unload MyDialog

Note also that the calling process is responsible for both loading and unloading the userform. Only this way we can benefit the possibilities a userform may offer. It's therefore highly recommended to load all your userforms in this way. Finally, note that in this particular case only one property of the userform is used by the calling code and therefore the userform itself has been made responsible for placing itself on the screen.

With regard to cloning the desired worksheet I provide two methods of doing that: 1) simply copying the worksheet and 2) your original approach by adding a new sheet and copying data across. This way you can use the method that best suits your needs.


This goes in the module of userform ufTabSelect:
VBA Code:
Option Explicit

Private Const ENABLEAPPLYBUTTON As Boolean = False  ' <<< set to TRUE if command button is used for user confirmation

Private Type TLocals
    SheetNameFromCombo  As String
End Type
Private this As TLocals

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ' prevent premature termination by user
    If CloseMode = vbFormControlMenu Then
        Cancel = True
    End If
End Sub

Private Sub UserForm_Initialize()
    With Me
        .StartUpPosition = 0
        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
    End With
End Sub

Private Sub CbtnDONE_Click()                        ' <<< change event handler name according to button name (if button is used for user confirmation)
    ' stay on screen if user didn't make a choice
    If Len(this.SheetNameFromCombo) > 0 Then
        Me.Hide
    End If
End Sub

Private Sub cboSheets_Change()
    this.SheetNameFromCombo = cboSheets.Value
    If Not ENABLEAPPLYBUTTON Then Me.Hide
End Sub

Public Function WorksheetChosenByUser(ByVal argWb As Workbook) As Worksheet
    If Not argWb Is Nothing Then
        Dim sht As Worksheet
        For Each sht In argWb.Worksheets
            Me.cboSheets.AddItem sht.Name
        Next
        Me.Show
        Set WorksheetChosenByUser = argWb.Worksheets(this.SheetNameFromCombo)
    End If
End Function


This goes in the module of userform ufImport:
VBA Code:
Private Sub cbCY_Click()

    '  --- userform ufImport ---

    Dim wbMe        As Workbook
    Dim wbImportWB  As Workbook
    Dim FullName    As String
    Dim impSheet    As Worksheet
    Dim NewCYSheet  As Worksheet

    If Not Me.cboType.Value = "" Then

        'Allows user to select the CY report with the File Picker dialog
        FullName = GetFileNameFromUserDialog

        If Len(FullName) > 0 Then
            
            Me.lblCYProcess.Visible = True

            Set wbMe = ThisWorkbook
            wbMe.Names("CYwbSheetInt").RefersToRange.ClearContents

            Set wbImportWB = WorkbookToBeImported(FullName)
            If wbImportWB Is Nothing Then GoTo SUB_ABORT
            If FirstCellOnFirstSheetIsBlank(wbImportWB) Then GoTo SUB_ABORT
            If FirstRowOnFirstSheetIsMerged(wbImportWB) Then GoTo SUB_ABORT

            Set impSheet = GetSheetFromOtherWorkbook(wbImportWB)
            If Not impSheet Is Nothing Then

                Application.ScreenUpdating = False
                Set NewCYSheet = GetClonedSheet(impSheet, wbMe)
                impSheet.Parent.Close SaveChanges:=False
                AddListingAndSeq NewCYSheet
                Application.ScreenUpdating = True

            End If
            Sheets(" ").Select
            Me.imgCYchk.Visible = True
            Me.lblCYProcess.Visible = False
        Else
            ' user didn't pick a file, cancel was pressed
        End If
    Else
        MsgBox "Error!" & vbCrLf & vbCrLf & "You must select a review type to continue.", vbCritical, "Need Type"
    End If
Exit Sub

SUB_ABORT:

    Me.Hide
End Sub


This goes in a (separate) standard module:
VBA Code:
Public Function GetFileNameFromUserDialog() As String
' dependency of cbCY_Click event handler on userform ufImport
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select the CY listing"
        .Filters.Add "Excel and CSV files", "*.csv; *.xls; *.xls*", 1
        If .Show Then
            GetFileNameFromUserDialog = .SelectedItems(1)
        End If
    End With
End Function

Public Function FirstRowOnFirstSheetIsMerged(ByVal argWb As Workbook) As Boolean
' dependency of cbCY_Click event handler on userform ufImport
    If Not argWb Is Nothing Then
        Dim FirstMergeRow As Long
        FirstMergeRow = Merge_Row(argWb.Sheets(1).Rows("1:1"))
        If FirstMergeRow = 0 Then
            ' do nothing
        Else
            FirstRowOnFirstSheetIsMerged = True
            argWb.Close SaveChanges:=False
            MsgBox "The first row of the listing contains merged cells. Please update the listing to unmerge all cells, " & _
                   "ensure each column has a heading, and then try importing again.", vbCritical, "Listing Error"
        End If
    End If
End Function

Public Function FirstCellOnFirstSheetIsBlank(ByVal argWb As Workbook) As Boolean
' dependency of cbCY_Click event handler on userform ufImport
    If Not argWb Is Nothing Then
        If argWb.Sheets(1).Range("A1").Value = "" Then
            FirstCellOnFirstSheetIsBlank = True
            argWb.Close SaveChanges:=False
            MsgBox "There's a problem with the listing. The first cell of the listing is blank. Please ensure the listing " & _
                   "has one row of headers and that header row is on the first row.", vbCritical, "Listing Error"
        End If
    End If
End Function

Public Function WorkbookToBeImported(ByVal argFullName As String) As Workbook
' dependency of cbCY_Click event handler on userform ufImport
    If Not IsFileOpen(argFullName) Then
        On Error Resume Next
        Set WorkbookToBeImported = Application.Workbooks.Open(argFullName)
        On Error GoTo 0
    Else
        MsgBox "The CY listing is open on your computer. Please close and retry import.", vbInformation, "CY Listing Open"
    End If
End Function

Public Function GetSheetFromOtherWorkbook(ByVal argWb As Workbook) As Worksheet
' dependency of cbCY_Click event handler on userform ufImport
    If argWb.Sheets.Count = 1 Then
        ' get the only worksheet
        Set GetSheetFromOtherWorkbook = argWb.Sheets(1)
    Else
        ' get worksheet through users choice
        Dim MyDialog    As ufTabSelect
        Set MyDialog = New ufTabSelect
        Set GetSheetFromOtherWorkbook = MyDialog.WorksheetChosenByUser(argWb)
        Unload MyDialog
    End If
End Function

Public Function GetClonedSheet(ByVal argSheetToBeCloned As Worksheet, ByVal argTargetWorkbook As Workbook) As Worksheet
' dependency of cbCY_Click event handler on userform ufImport

    ' copy source sheet to target workbook and rename it to "CY"  <<<<
    With argTargetWorkbook
    
        ' ensure there's no sheet named "CY" in the target workbook
        Application.DisplayAlerts = False
        On Error Resume Next
        .Sheets("CY").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        
        ' copy source sheet to target workbook
        argSheetToBeCloned.Copy After:=.Sheets(.Sheets.Count)
        
        ' return with a reference to this new sheet
        Set GetClonedSheet = .Sheets(.Sheets.Count)
        GetClonedSheet.Name = "CY"
    End With
End Function

Public Function GetClonedSheet_v2(ByVal argSheetToBeCloned As Worksheet, ByVal argTargetWorkbook As Workbook) As Worksheet
' dependency of cbCY_Click event handler on userform ufImport

'  >>>> approach 2: (your orignal approach) add a new sheet to target workbook and copy source data to newly added sheet <<<<
    With argTargetWorkbook
    
        ' ensure there's no sheet named "CY" in the target workbook
        Application.DisplayAlerts = False
        On Error Resume Next
        .Sheets("CY").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        
        ' add a new blank sheet to target workbook
        Set GetClonedSheet_v2 = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        GetClonedSheet_v2.Name = "CY"
    End With

    ' copy data
    With argSheetToBeCloned
        Dim LastRow As Long, LastCol  As Long
        On Error Resume Next
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        On Error GoTo 0
        If LastRow > 0 And LastCol > 0 Then
            .Range(.Cells(1, 1), .Cells(LastRow, LastCol)).Copy GetClonedSheet_v2.Cells(1, 1)
        End If
    End With
End Function

Public Sub AddListingAndSeq(ByVal argSht As Worksheet)
' dependency of cbCY_Click event handler on userform ufImport
    If Not argSht Is Nothing Then
        With argSht
            .Columns("A:A").Insert Shift:=xlToRight
            .Range("A1").Value = "Listing Rec #"
    
            Dim lrow As Long, r As Long
            lrow = .Cells(.Rows.Count, "B").End(xlUp).Row
            For r = 2 To lrow
                .Cells(r, 1) = "CY" & r - 1
            Next r
    
            On Error Resume Next
            .Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            On Error GoTo 0
        End With
    End If
End Sub
 
Upvote 0
Solution
In order to understand what your code does and also to determine what could be the cause of your issue, I have sliced your code a bit. Certain subtasks are now performed by separate procedures, often in the form of a function, i.e. the procedure returns a certain value or object when returning to the calling process. You already made use of this functionality in your original code, the IsFileOpen and Merge_Row functions are examples of this. The effect of slicing code this way is that the code is much more readable and maintainable. In addition, by using descriptive names there's no problem with omitting additional comments.

By the way, I couldn't reproduce your problem. That said, I also revised the code of the userform called ufTabSelect in its entirety. Note that this userform is extended with a custom property named WorksheetChosenByUser. In this context it's essential that the userform is loaded into memory by "NEW-ing" it like in the code snippet below (instead of using the userform's default instance).

Code snippet of function GetSheetFromOtherWorkbook:
VBA Code:
    Dim MyDialog    As ufTabSelect
    Set MyDialog = New ufTabSelect
    Set GetSheetFromOtherWorkbook = MyDialog.WorksheetChosenByUser(argWb)
    Unload MyDialog

Note also that the calling process is responsible for both loading and unloading the userform. Only this way we can benefit the possibilities a userform may offer. It's therefore highly recommended to load all your userforms in this way. Finally, note that in this particular case only one property of the userform is used by the calling code and therefore the userform itself has been made responsible for placing itself on the screen.

With regard to cloning the desired worksheet I provide two methods of doing that: 1) simply copying the worksheet and 2) your original approach by adding a new sheet and copying data across. This way you can use the method that best suits your needs.


This goes in the module of userform ufTabSelect:
VBA Code:
Option Explicit

Private Const ENABLEAPPLYBUTTON As Boolean = False  ' <<< set to TRUE if command button is used for user confirmation

Private Type TLocals
    SheetNameFromCombo  As String
End Type
Private this As TLocals

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ' prevent premature termination by user
    If CloseMode = vbFormControlMenu Then
        Cancel = True
    End If
End Sub

Private Sub UserForm_Initialize()
    With Me
        .StartUpPosition = 0
        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
    End With
End Sub

Private Sub CbtnDONE_Click()                        ' <<< change event handler name according to button name (if button is used for user confirmation)
    ' stay on screen if user didn't make a choice
    If Len(this.SheetNameFromCombo) > 0 Then
        Me.Hide
    End If
End Sub

Private Sub cboSheets_Change()
    this.SheetNameFromCombo = cboSheets.Value
    If Not ENABLEAPPLYBUTTON Then Me.Hide
End Sub

Public Function WorksheetChosenByUser(ByVal argWb As Workbook) As Worksheet
    If Not argWb Is Nothing Then
        Dim sht As Worksheet
        For Each sht In argWb.Worksheets
            Me.cboSheets.AddItem sht.Name
        Next
        Me.Show
        Set WorksheetChosenByUser = argWb.Worksheets(this.SheetNameFromCombo)
    End If
End Function


This goes in the module of userform ufImport:
VBA Code:
Private Sub cbCY_Click()

    '  --- userform ufImport ---

    Dim wbMe        As Workbook
    Dim wbImportWB  As Workbook
    Dim FullName    As String
    Dim impSheet    As Worksheet
    Dim NewCYSheet  As Worksheet

    If Not Me.cboType.Value = "" Then

        'Allows user to select the CY report with the File Picker dialog
        FullName = GetFileNameFromUserDialog

        If Len(FullName) > 0 Then
           
            Me.lblCYProcess.Visible = True

            Set wbMe = ThisWorkbook
            wbMe.Names("CYwbSheetInt").RefersToRange.ClearContents

            Set wbImportWB = WorkbookToBeImported(FullName)
            If wbImportWB Is Nothing Then GoTo SUB_ABORT
            If FirstCellOnFirstSheetIsBlank(wbImportWB) Then GoTo SUB_ABORT
            If FirstRowOnFirstSheetIsMerged(wbImportWB) Then GoTo SUB_ABORT

            Set impSheet = GetSheetFromOtherWorkbook(wbImportWB)
            If Not impSheet Is Nothing Then

                Application.ScreenUpdating = False
                Set NewCYSheet = GetClonedSheet(impSheet, wbMe)
                impSheet.Parent.Close SaveChanges:=False
                AddListingAndSeq NewCYSheet
                Application.ScreenUpdating = True

            End If
            Sheets(" ").Select
            Me.imgCYchk.Visible = True
            Me.lblCYProcess.Visible = False
        Else
            ' user didn't pick a file, cancel was pressed
        End If
    Else
        MsgBox "Error!" & vbCrLf & vbCrLf & "You must select a review type to continue.", vbCritical, "Need Type"
    End If
Exit Sub

SUB_ABORT:

    Me.Hide
End Sub


This goes in a (separate) standard module:
VBA Code:
Public Function GetFileNameFromUserDialog() As String
' dependency of cbCY_Click event handler on userform ufImport
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select the CY listing"
        .Filters.Add "Excel and CSV files", "*.csv; *.xls; *.xls*", 1
        If .Show Then
            GetFileNameFromUserDialog = .SelectedItems(1)
        End If
    End With
End Function

Public Function FirstRowOnFirstSheetIsMerged(ByVal argWb As Workbook) As Boolean
' dependency of cbCY_Click event handler on userform ufImport
    If Not argWb Is Nothing Then
        Dim FirstMergeRow As Long
        FirstMergeRow = Merge_Row(argWb.Sheets(1).Rows("1:1"))
        If FirstMergeRow = 0 Then
            ' do nothing
        Else
            FirstRowOnFirstSheetIsMerged = True
            argWb.Close SaveChanges:=False
            MsgBox "The first row of the listing contains merged cells. Please update the listing to unmerge all cells, " & _
                   "ensure each column has a heading, and then try importing again.", vbCritical, "Listing Error"
        End If
    End If
End Function

Public Function FirstCellOnFirstSheetIsBlank(ByVal argWb As Workbook) As Boolean
' dependency of cbCY_Click event handler on userform ufImport
    If Not argWb Is Nothing Then
        If argWb.Sheets(1).Range("A1").Value = "" Then
            FirstCellOnFirstSheetIsBlank = True
            argWb.Close SaveChanges:=False
            MsgBox "There's a problem with the listing. The first cell of the listing is blank. Please ensure the listing " & _
                   "has one row of headers and that header row is on the first row.", vbCritical, "Listing Error"
        End If
    End If
End Function

Public Function WorkbookToBeImported(ByVal argFullName As String) As Workbook
' dependency of cbCY_Click event handler on userform ufImport
    If Not IsFileOpen(argFullName) Then
        On Error Resume Next
        Set WorkbookToBeImported = Application.Workbooks.Open(argFullName)
        On Error GoTo 0
    Else
        MsgBox "The CY listing is open on your computer. Please close and retry import.", vbInformation, "CY Listing Open"
    End If
End Function

Public Function GetSheetFromOtherWorkbook(ByVal argWb As Workbook) As Worksheet
' dependency of cbCY_Click event handler on userform ufImport
    If argWb.Sheets.Count = 1 Then
        ' get the only worksheet
        Set GetSheetFromOtherWorkbook = argWb.Sheets(1)
    Else
        ' get worksheet through users choice
        Dim MyDialog    As ufTabSelect
        Set MyDialog = New ufTabSelect
        Set GetSheetFromOtherWorkbook = MyDialog.WorksheetChosenByUser(argWb)
        Unload MyDialog
    End If
End Function

Public Function GetClonedSheet(ByVal argSheetToBeCloned As Worksheet, ByVal argTargetWorkbook As Workbook) As Worksheet
' dependency of cbCY_Click event handler on userform ufImport

    ' copy source sheet to target workbook and rename it to "CY"  <<<<
    With argTargetWorkbook
   
        ' ensure there's no sheet named "CY" in the target workbook
        Application.DisplayAlerts = False
        On Error Resume Next
        .Sheets("CY").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
       
        ' copy source sheet to target workbook
        argSheetToBeCloned.Copy After:=.Sheets(.Sheets.Count)
       
        ' return with a reference to this new sheet
        Set GetClonedSheet = .Sheets(.Sheets.Count)
        GetClonedSheet.Name = "CY"
    End With
End Function

Public Function GetClonedSheet_v2(ByVal argSheetToBeCloned As Worksheet, ByVal argTargetWorkbook As Workbook) As Worksheet
' dependency of cbCY_Click event handler on userform ufImport

'  >>>> approach 2: (your orignal approach) add a new sheet to target workbook and copy source data to newly added sheet <<<<
    With argTargetWorkbook
   
        ' ensure there's no sheet named "CY" in the target workbook
        Application.DisplayAlerts = False
        On Error Resume Next
        .Sheets("CY").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
       
        ' add a new blank sheet to target workbook
        Set GetClonedSheet_v2 = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        GetClonedSheet_v2.Name = "CY"
    End With

    ' copy data
    With argSheetToBeCloned
        Dim LastRow As Long, LastCol  As Long
        On Error Resume Next
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        On Error GoTo 0
        If LastRow > 0 And LastCol > 0 Then
            .Range(.Cells(1, 1), .Cells(LastRow, LastCol)).Copy GetClonedSheet_v2.Cells(1, 1)
        End If
    End With
End Function

Public Sub AddListingAndSeq(ByVal argSht As Worksheet)
' dependency of cbCY_Click event handler on userform ufImport
    If Not argSht Is Nothing Then
        With argSht
            .Columns("A:A").Insert Shift:=xlToRight
            .Range("A1").Value = "Listing Rec #"
   
            Dim lrow As Long, r As Long
            lrow = .Cells(.Rows.Count, "B").End(xlUp).Row
            For r = 2 To lrow
                .Cells(r, 1) = "CY" & r - 1
            Next r
   
            On Error Resume Next
            .Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            On Error GoTo 0
        End With
    End If
End Sub

Thank you very much for all of this. The explanations are greatly appreciated and you've structured everything in a much more logical way than I attempted. Tested and everything works perfectly.
 
Upvote 0
You are welcome and thanks for the follow-up.
 
Upvote 0

Forum statistics

Threads
1,223,727
Messages
6,174,144
Members
452,547
Latest member
Schilling

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