|
Code needs simplifying
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 |
Code needs simplifying
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 In article , "Sandy" wrote: 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 |
Code needs simplifying
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 ' In article , JE McGimpsey wrote: 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 |
Code needs simplifying
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 "Don Guillett" wrote in message ... 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 -- Don Guillett SalesAid Software "Sandy" wrote in message ... 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 |
Code needs simplifying
Sorry I didn't get back to you sooner. Didn't see it. NO selections
necessary Sub sa() sheets("yoursheetname").Range("H6:AC536").ClearCon tents Sheets("Sheet2").Range("B6,B100,E10,B15,E15,B19,E1 9,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").ClearCon tents Sheets("Sheet2").Range("B6,B100,E10,B15,E15,B19,E1 9,B23,E23,B26,E26,B30,E30").ClearContents With Sheets("sheet1") If .FilterMode Then .ShowAllData End If End With End Sub -- Don Guillett SalesAid Software "Sandy" wrote in message ... 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 "Don Guillett" wrote in message ... 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 -- Don Guillett SalesAid Software "Sandy" wrote in message ... 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 |
| All times are GMT +1. The time now is 01:26 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com