Code needs simplifying

S

Sandy

Hi

I have the following macro attached to a button on "Sheet2". User input is
gathered in certain cells on "Sheet2" and then via the (recorded) macro
transported to the Criteria area of a list for Advanced filtering. It all
works fine - except there is a whole lot of screen flickering - presumably
due to the macro diving back and forwards between sheets.

My question is simple - the answer may not be - can the code be simplified
to run more efficiently?

Any help would be appreciated.

Sandy

Macro Code>>
Sub Send_Criteria()

Sheets("Sheet2").Select
Range("B6").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("B10").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("E10").Select
Selection.Copy
Sheets("Sheet1").Select
Range("W2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("B15").Select
Selection.Copy
Sheets("Sheet1").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("E15").Select
Selection.Copy
Sheets("Sheet1").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("B19").Select
Selection.Copy
Sheets("Sheet1").Select
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("E19").Select
Selection.Copy
Sheets("Sheet1").Select
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("B23").Select
Selection.Copy
Sheets("Sheet1").Select
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("E23").Select
Selection.Copy
Sheets("Sheet1").Select
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("B26").Select
Selection.Copy
Sheets("Sheet1").Select
Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("E26").Select
Selection.Copy
Sheets("Sheet1").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("B30").Select
Selection.Copy
Sheets("Sheet1").Select
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet2").Select
Application.CutCopyMode = False
Range("E30").Select
Selection.Copy
Sheets("Sheet1").Select
Range("N2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Range("A11").Select
Sheets("Sheet2").Select
Application.CutCopyMode = False

Range("A2").Select
End Sub
 
D

Don Guillett

use this for NO selections.
Sheets("Sheet1").range("a2").value=Sheets("Sheet2").Range("B6").value
'etc
'can be even more simplified by using a WITH (look in help) statement.
instead of

Sheets("Sheet2").Select
Range("B6").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
 
J

JE McGimpsey

One way:

Public Sub Send_Criteria()
Dim wsSource As Worksheet
Dim wsDest As Worksheet

Set wsSource = ActiveWorkbook.Sheets("Sheet2")
Set wsDest = ActiveWorkbook.Sheets("Sheet1")

With wsSource
rDest.Range("A2").Value = .Range("B6").Value
rDest.Range("B2").Value = .Range("B10").Value
rDest.Range("W2").Value = .Range("E10").Value
rDest.Range("D2").Value = .Range("B15").Value
rDest.Range("E2").Value = .Range("E15").Value
rDest.Range("R2").Value = .Range("B19").Value
rDest.Range("H2").Value = .Range("E19").Value
rDest.Range("I2").Value = .Range("B23").Value
rDest.Range("J2").Value = .Range("E23").Value
rDest.Range("K2").Value = .Range("B26").Value
rDest.Range("L2").Value = .Range("E26").Value
rDest.Range("M2").Value = .Range("B30").Value
rDest.Range("N2").Value = .Range("E30").Value
rDest.Range("A2").Value = .Range("B6").Value
rDest.Range("A2").Value = .Range("B6").Value
rDest.Range("A2").Value = .Range("B6").Value
End With
End Sub
 
J

JE McGimpsey

Oops - Apparently pasted in old copy. Try:

Public Sub Send_Criteria()
Dim wsSource As Worksheet
Dim wsDest As Worksheet

Set wsSource = ActiveWorkbook.Sheets("Sheet2")
Set wsDest = ActiveWorkbook.Sheets("Sheet1")

With wsSource
wsDest.Range("A2").Value = .Range("B6").Value
wsDest.Range("B2").Value = .Range("B10").Value
wsDest.Range("W2").Value = .Range("E10").Value
wsDest.Range("D2").Value = .Range("B15").Value
wsDest.Range("E2").Value = .Range("E15").Value
wsDest.Range("R2").Value = .Range("B19").Value
wsDest.Range("H2").Value = .Range("E19").Value
wsDest.Range("I2").Value = .Range("B23").Value
wsDest.Range("J2").Value = .Range("E23").Value
wsDest.Range("K2").Value = .Range("B26").Value
wsDest.Range("L2").Value = .Range("E26").Value
wsDest.Range("M2").Value = .Range("B30").Value
wsDest.Range("N2").Value = .Range("E30").Value
End With
End Sub
'
 
S

Sandy

Don
Thank you it works much better.

Can I impose another question upon you?

I have a macro which clears the input cells and also resets the Data List:-

Sub ClearList()
Range("H6:AC536").Select
Selection.ClearContents
Range("A2").Select

Sheets("Sheet1").Select
ActiveSheet.ShowAllData
Range("A10").Select

Sheets("Sheet2").Select
Range("B6,B100,E10,B15,E15,B19,E19,B23,E23,B26,E26,B30,E30").Select
Selection.ClearContents

Range("A2").Select
End Sub
Again this works fine - but if someone were to press the button for this
code when it has already been reset, then the following error message
springs up:-

"Run-time error '1004'
ShowAllData method of Worksheet class failed. Any solution appreciated.

Thanks in advance and also for your earlier reply

Sandy
 
D

Don Guillett

Sorry I didn't get back to you sooner. Didn't see it. NO selections
necessary

Sub sa()
sheets("yoursheetname").Range("H6:AC536").ClearContents
Sheets("Sheet2").Range("B6,B100,E10,B15,E15,B19,E19,B23,E23,B26,E26,B30,E30").ClearContents

On Error GoTo away
Sheets("sheet1").ShowAllData
away:
End Sub

or
Sub sa1()
sheets("yoursheetname").Range("H6:AC536").ClearContents
Sheets("Sheet2").Range("B6,B100,E10,B15,E15,B19,E19,B23,E23,B26,E26,B30,E30").ClearContents

With Sheets("sheet1")
If .FilterMode Then
.ShowAllData
End If
End With

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help merging two VBA codes 2
Replace a fixed number with a variable via popup 3
Can't Prevent Recalculation 4
Filename Problem In a Macro 4
Macro to run on hidden sheet 4
Having difficulty copying and pasting on VBA 3
Need to Speed Up A Code 2
Advanced filtering macro 2

Top