Error re-running code

Viewed 400

firstly, I'm having error running the code from Excel workbook directly. It leads to the error message mentioned below

We looked at all the data next to your selection and didn't see a pattern for filling in values for you. To use Flash Fill, enter a couple of examples of the output you'd like to see, keep the active cell in the column you want filled in and click the Flash Fill button again

However, I could run the code if is played from VBA windows under the developers tab. But Is limited to only 1 run before an error message 1004 pops up and also code error when played again.

Please help. Never taught or learnt VBA in ever. Code below is a mash up of researched on the net and trial & error.

Sub Graph()
'
' Graph Macro
'
' Keyboard Shortcut: Ctrl+e
'
'Select values in a column from specified workbook and sheet
Dim LR As Long, cell As Range, rng As Range

Windows("Area3-LG").Activate
With Sheets("Graph data")
    LR = .Range("B" & Rows.Count).End(xlUp).Row
    For Each cell In .Range("B4:B" & LR)
        If cell.Value <> "" Then
            If rng Is Nothing Then
                Set rng = cell
            Else
                Set rng = Union(rng, cell)
            End If
        End If
    Next cell
    'Error with rng.select when Macro is runned again
    rng.Select    
End With
Selection.Copy

'Open next workbook
Windows("InstData_TEMS_Existing").Activate
'Open Sheet L
Sheets("L").Select
'Select empty field fromn column AA
Range("AA" & Rows.Count).End(xlUp).Offset(1).Select
'paste selection to empty field
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
'Go back to previous workbook & delete column
Windows("Area3-LG").Activate
Sheets("Graph data").Select
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Sheets("Graph Data").Select

End Sub

Thanks in advance (:

1 Answers

Try the code below, without all the unnecessary Select, Activate, and Selection:

Sub Graph()
'
' Graph Macro
'
' Keyboard Shortcut: Ctrl+e
'
'Select values in a column from specified workbook and sheet
Dim LR As Long, cell As Range, rng As Range

With Workbooks("Area3-LG").Sheets("Graph data")
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    For Each cell In .Range("B4:B" & LR)
        If cell.Value <> "" Then
            If rng Is Nothing Then
                Set rng = cell
            Else
                Set rng = Union(rng, cell)
            End If
        End If
    Next cell
End With
rng.Copy ' copy the union range (no need to select it first)

' paste without all the selecting
With Windows("InstData_TEMS_Existing").Sheets("L")
    ' Paste (without select) un the next empty cell fromn column AA
    .Range("AA" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
End With

Application.CutCopyMode = False

'Go back to previous workbook & delete column
Workbooks("Area3-LG").Sheets("Graph data").Columns("B:B").Delete Shift:=xlToLeft

End Sub
Related