Search code examples
excelrangeuserformvba

VBA- Using RefEdit for copying range between workbooks


I wanted to copy some not continous ranges from several workbook/ worksheets to a specific sheet. I am using a userform and RefEdit control on that. But the Excel freezs each time I am calling the form and addressing the ranges! I can't do anything except End Excel! Here is my Code.

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = Range(Me.RefEdit1.Value)
rng.Copy
ThisWorkbook.Sheets("Transfer").Range("a1").PasteSpecial xlPasteValues
End Sub 

Private Sub UserForm_Activate()
For Each wb In Application.Workbooks
   ComboBox1.AddItem wb.Name
Next
ComboBox1 = ActiveWorkbook.Name
End Sub

Private Sub Combobox1_Change()
If ComboBox1 <> "" Then Application.Workbooks(ComboBox1.Text).Activate
End Sub

My Form was showed modeless.

https://1drv.ms/u/s!ArGi1KRQ5iItga8CLrZr9JpB67dEUw

So really not sure I can copy with this method or not. As I was not able to test my form. Thanks, M


Solution

  • No RefEdit in a modeless Userform

    The problem is that you cannot use a modeless userform containing a RefEdit control. Otherwise Excel loses control over the keyboard focus and can only be terminated via task manager or Ctrl + Alt + Delete. So you'll have to show your Userform modal (e.g. expressly by .Show vbModal or without this default argument).

    Further hints:

    Don't use a RefEdit control within another control, especially not within a Frame control, this can cause issues.

    Check if you get a valid range (see Helper function getRng below), then you can assign the new values simply by coding ThisWorkbook.Sheets("Transfer").Range("A1") = Range(Me.RefEdit1.Value) instead of using Copy and Paste.

    For non contiguos ranges there are number of code examples at SO, but that's not the cause of Excel freezing. In the code example below I assume that you want to write one cell only to worksheet range Target!A1.

    Furthermore I added a boolean variable bReady in order to lock or unlock the Combobox1_Change() event and prevent unnecessary activations.

    Code example

    Option Explicit         ' declaration head of UserForm Code module
    Dim bReady As Boolean   ' boolean flag to show completion of workbook list
    
    Private Sub CommandButton1_Click()
    Dim rng As Range
    Set rng = getRng(Me.RefEdit1.Value) ' << use helper function getRng
    If Not rng Is Nothing Then
      'write only first cell back to cell Transfer!A1
       ThisWorkbook.Sheets("Transfer").Range("A1").Value = rng.Cells(1).Value
      'correct address to one cell only
       bReady = False
       RefEdit1.Value = rng.Parent.Name & "!" & rng.Cells(1).Address
       bReady = True
       RefEdit1.ControlTipText = "Value of " & RefEdit1.Value & " = " & Format(rng.Cells(1).Value, "General")
    Else    ' after manual input of not existing ranges
       RefEdit1.Value = "": Me.RefEdit1.ControlTipText = "None": Beep
       RefEdit1.SetFocus
    End If
    End Sub
    
    Private Sub UserForm_Activate()
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        ComboBox1.AddItem wb.Name
    Next
    ComboBox1 = ActiveWorkbook.Name
    bReady = True       ' allow workbooks activation in Combobox1_Change event
    End Sub
    
    Private Sub Combobox1_Change()
    If Not bReady Then Exit Sub         ' avoids activation before completion of workbooks list
    If ComboBox1 <> "" Then Application.Workbooks(ComboBox1.Text).Activate
    End Sub
    

    Helper function getRng()

    Function getRng(ByVal sRng As String) As Range
    ' Purpose: return valid range object or return Nothing
    On Error Resume Next
    Set getRng = Range(sRng)
    If Err.Number <> 0 Then Err.Clear
    End Function
    

    Edit: treating non contiguous areas

    Pressing the Ctrl key you are able to select non contiguous ranges, e.g. Sheet1!D12:E15,Sheet1!B7:C10 as completely separate areas (separated by a colon in RefEdit). Referring to your comment, I added the following example how to write back contiguous and non contiguous areas via a variant datafield array (called v in the below example code). As far as I understood you alwayas want to start at cell A1 in your target sheet:

    Private Sub CommandButton1_Click()
    Dim rng As Range, r As Range, v As Variant
    Dim i As Long, n As Long
    Dim iRowOffset As Long, temp As Long
    Dim iColOffset As Long
    Dim ws  As Worksheet
    Set ws = ThisWorkbook.Worksheets("Transfer")
    Set rng = getRng(Me.RefEdit1.Value) ' << use helper function getRng
    If Not rng Is Nothing Then
      ' a) count (non) contiguous areas obtained via Ctrl-key in RefEdit (e.g. "D13:D15,A1:B2")
        n = rng.Areas.Count
      ' b) calculate necessary row/col offset to start copies at A1 in target sheet
        iRowOffset = rng.Areas(1).Row - 1
        iColOffset = rng.Areas(1).Column - 1
        For i = 1 To n
            temp = rng.Areas(i).Row - 1
            If temp < iRowOffset And temp > 0 Then iRowOffset = temp
            temp = rng.Areas(i).Column - 1
            If temp < iColOffset And temp > 0 Then iColOffset = temp
        Next i
      ' c) write values back
        For i = 1 To n
          With rng.Areas(i).Parent.Name ' sheet
             v = rng.Areas(i)           ' write values to variant 1-based 2-dim array
             ws.Range(rng.Areas(i).Address).Offset(-iRowOffset, -iColOffset) = v
          End With
        Next i
    
    Else    ' after manual input of not existing ranges
       RefEdit1.Value = "":  Beep
       RefEdit1.SetFocus
    End If
    End Sub