InputBox is slowing down my code

[munuelitu]

Hello

Given a selection, I want to copy the cells fills of it to another part of the sheet

I have a macro that stores the cell fill colors and patterns of a selected range in arrays. Then the arrays data are used to paint the cells of another zone

This macro takes about a second to run

But if I use an InputBox for the user to select one cell, even if I do nothing with it, the code takes 10-12 seconds, so just by appearing it slows down the whole code

Any ideas?

Sub aaa()


Dim arrPatern() As Variant
Dim arrPatCol() As Variant
Dim arrColors() As Variant
Dim arrValues() As Variant
Application.ScreenUpdating = False

'verifiquem que no hi ha merda combinada
    For Each c In Selection
        If c.MergeCells Then
            MsgBox ("Sorry, this macro can't work with merged (combined) cells. Aborting...")
            Exit Sub
        End If
    Next c

'time capture at beginning to check execution time
    ini = Strings.Format(Now, "HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)

'limits of the selection
    first_ro = Selection.Row
    first_co = Selection.Column
    last_ro = first_ro + Selection.Rows.Count - 1
    last_co = first_co + Selection.Columns.Count - 1

'arrays redimensioning according to selection size
    ReDim arrPatern(1 To Selection.Rows.Count, 1 To Selection.Columns.Count) 'arrC = Range("F3:F18")
    ReDim arrPatCol(1 To Selection.Rows.Count, 1 To Selection.Columns.Count) 'arrC = Range("F3:F18")
    ReDim arrColors(1 To Selection.Rows.Count, 1 To Selection.Columns.Count) 'arrC = Range("F3:F18")
    ReDim arrValues(1 To Selection.Rows.Count, 1 To Selection.Columns.Count) 'arrC = Range("F3:F18")

'get the data from selection to array
    For ro = 1 To UBound(arrPatern, 1)
        For co = 1 To UBound(arrPatern, 2)
            arrPatern(ro, co) = Cells(first_ro - 1 + ro, first_co - 1 + co).Interior.Pattern
            arrPatCol(ro, co) = Cells(first_ro - 1 + ro, first_co - 1 + co).Interior.PatternColor
            arrColors(ro, co) = Cells(first_ro - 1 + ro, first_co - 1 + co).Interior.Color
            arrValues(ro, co) = Cells(first_ro - 1 + ro, first_co - 1 + co).Value
        Next co
    Next ro


'Inputbox to get destination
tornahi:
    'Set desti = Application.InputBox(prompt:="Marca la primera cel·la de la nova ubicació", Type:=8)
    Set desti = Range("F3") ' -----> If i comment line above and use this one, code is very fast
    
    If desti.Count <> 1 Then
        MsgBox ("Only one cell is allowed")
        GoTo tornahi
    End If
    'ro_des = desti.Row
    'co_des = desti.Column



'paint the cells from selection to a fixed cell MW22 (should be the cell from Inputbox, this is only to prove code is fast without Inputbox)
    For ro = 1 To UBound(arrPatern, 1)
        For co = 1 To UBound(arrPatern, 2)
            If arrPatern(ro, co) <> -4142 Or arrValue <> "" Then
                Cells(21 + ro, 361 - 1 + co).Interior.Pattern = arrPatern(ro, co)
                Cells(21 + ro, 361 - 1 + co).Interior.PatternColor = arrPatCol(ro, co)
                Cells(21 + ro, 361 - 1 + co).Interior.Color = arrColors(ro, co)
                Cells(21 + ro, 361 - 1 + co).Value = arrValues(ro, co)
            End If
        Next co
    Next ro

'time capture at end to check execution time
    fini = Strings.Format(Now, "HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)
    MsgBox (ini & " ----> " & fini)

End Sub

 

[Rick Rothstein]

[table="width: 500"]
[tr]
	[td]'verifiquem que no hi ha merda combinada
    For Each c In Selection
        If c.MergeCells Then
            MsgBox ("Sorry, this macro can't work with merged (combined) cells. Aborting...")
            Exit Sub
        End If
    Next c[/td]
[/tr]
[/table]

I don't have the time right now to look into your question or code, but I thought you might like to know the the above part of your code can be replaced with this non-looping snippet of code...

[table="width: 500"]
[tr]
	[td]If IsNull(Selection.MergeCells) Or Selection.MergeCells = True Then
  MsgBox ("Sorry, this macro can't work with merged (combined) cells. Aborting...")
  Exit Sub
End If[/td]
[/tr]
[/table]

 

[munuelitu]

Hi Rick

Thank's for the tip, it is highly appreciated. Much more elegant.

I have uploaded my excel file to OneDrive in case it helps to clarify where the issue may be. You can download it from here:

https://maproa61649901-my.sharepoin...JCgAikO4PUWy4BZK79Pp_8AjFo7sfi5C25cg?e=taUznB

STEPS:

1) select a big range to copy, for example NK5:UR10
2) Run sub aaa from editor. It will copy the selected range to fixed cell MW22. It takes about 0.06 seconds to execute
3) Uncomment line:

'Set desti2 = Application.InputBox(prompt:="Marca la primera cel·la de la nova ubicació", Type:=8)

This makes an Inputbox appear and you need to click on any cell, nothing else is done.
4) when you accept the inputbox, the code will take now several seconds

Hope this clarifies.... any idea?