VBA Doubt and Simplification

Z

zaska

Well-known Member
Joined
Oct 24, 2010
Messages
1,046
Hi all,

Code: 
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 02-10-2009 by ZOOM
'
' Keyboard Shortcut: Ctrl+a
'
    Application.ScreenUpdating = False
    ChDir "E:\Macros\Input"
    Workbooks.Open Filename:="E:\Macros\Input\cm" & Format(Workbooks("NSE Converter.xls").Sheets("Sheet1").Range("G2").Value, "ddmmmyyyy") & "bhav.csv"
    Columns("B:B").Select
    Selection.Cut
    Columns("L:L").Select
    ActiveSheet.Paste
    Columns("K:K").Select
    Selection.Cut
    Columns("B:B").Select
    ActiveSheet.Paste
    Selection.NumberFormat = "yyyymmdd"
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Range("A1:H1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=8, Criteria1:="=BE", Operator:=xlOr, _
        Criteria2:="=EQ"
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.ScrollRow = 1
    Range("I1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1:H1").Select
    Selection.AutoFilter
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Range("B3").Select
    
    Workbooks.OpenText Filename:="E:\Macros\Input\MTO_" & Format(Workbooks("NSE Converter.xls").Sheets("Sheet1").Range("G2").Value, "ddmmyyyy") & ".DAT", Origin:=437, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers:=True
        
        
        
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Cut
    Columns("D:D").Select
    ActiveSheet.Paste
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:C1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=3, Criteria1:="EQ"
    Range("A2:B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("cm" & Format(Workbooks("NSE Converter.xls").Sheets("Sheet1").Range("G2").Value, "ddmmmyyyy") & "bhav.csv").Activate
    Range("I1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],C[1]:C[2],2,0)"
    Selection.Copy
    Range("H2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("H:H").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ChDir "E:\Macros\Output"
    ActiveWorkbook.SaveAs Filename:="E:\Macros\Output\Stocks\cm" & Format(Date, "ddmmmyyyy") & "bhav.txt", FileFormat:=xlCSV _
        , CreateBackup:=False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
    ActiveWindow.Close
    ActiveWindow.Close
    
    Application.ScreenUpdating = False
    ChDir "E:\Macros\Input"
    Workbooks.Open Filename:="E:\Macros\Input\fo" & Format(Workbooks("NSE Converter.xls").Sheets("Sheet1").Range("G2").Value, "ddmmmyyyy") & "bhav.csv", Origin:=xlWindows


I would seek the kind help of members to suggest in simplifying this recorded macro

Thanks
 
Sort by date Sort by votes
zaska said:
Hi all,

Code: 
   Range("A1:H1").AutoFilter Field:=8, Criteria1:="=BE", Operator:=xlOr, _
        Criteria2:="=EQ"
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.ScrollRow = 1
    Range("I1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1:H1").Select
    Selection.AutoFilter
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Range("B3").Select
In the above code i am trying to filter " BE " and " EQ " paste the filtered result next to the original table and delete the original table.

I would like to know whether there is any alternative for this

Thanks
Click to expand...

Looking for kind suggestion from members
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Ruddles said:
Code: 
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
can be replaced by:-
Code: 
    Columns("C:D").Select
    Selection.Delete Shift:=xlToLeft
Click to expand...
:oops:

I hang my head in shame! That's not correct: the first of those code blocks deletes column C and then after that has happened, it deletes column D - which was column E before column C was deleted. You wanted the original columns C and E deleted.

My suggested replacement code deletes columns C and D in one operation and leaves the original column E untouched, which is not what you wanted.

Am I explaining this adequately?

So don't change it - it works fine as it is (but see my footnote).

That might be why you have an unexpected column disappearing.

Please accept my apologies for giving you duff advice.

Footnote: personally, if I was deleting a series of different columns, I would do it from right to left. That way the letters of the columns which are still to be deleted don't change as the columns to their right are deleted.
 
Last edited:
Upvote 0
This doesn't address your specific need but for an introduction on what to do with Excel generated code see
Beyond the macro recorder
http://www.tushar-mehta.com/excel/vba/beyond_the_macro_recorder/


zaska said:
Hi all,

Code: 
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 02-10-2009 by ZOOM
'
' Keyboard Shortcut: Ctrl+a
'
    Application.ScreenUpdating = False
    ChDir "E:\Macros\Input"
    Workbooks.Open Filename:="E:\Macros\Input\cm" & Format(Workbooks("NSE Converter.xls").Sheets("Sheet1").Range("G2").Value, "ddmmmyyyy") & "bhav.csv"
    Columns("B:B").Select
    Selection.Cut
    Columns("L:L").Select
    ActiveSheet.Paste
    Columns("K:K").Select
    Selection.Cut
    Columns("B:B").Select
    ActiveSheet.Paste
    Selection.NumberFormat = "yyyymmdd"
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Range("A1:H1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=8, Criteria1:="=BE", Operator:=xlOr, _
        Criteria2:="=EQ"
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.ScrollRow = 1
    Range("I1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1:H1").Select
    Selection.AutoFilter
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Range("B3").Select
    
    Workbooks.OpenText Filename:="E:\Macros\Input\MTO_" & Format(Workbooks("NSE Converter.xls").Sheets("Sheet1").Range("G2").Value, "ddmmyyyy") & ".DAT", Origin:=437, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers:=True
        
        
        
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Cut
    Columns("D:D").Select
    ActiveSheet.Paste
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:C1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=3, Criteria1:="EQ"
    Range("A2:B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("cm" & Format(Workbooks("NSE Converter.xls").Sheets("Sheet1").Range("G2").Value, "ddmmmyyyy") & "bhav.csv").Activate
    Range("I1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],C[1]:C[2],2,0)"
    Selection.Copy
    Range("H2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("H:H").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ChDir "E:\Macros\Output"
    ActiveWorkbook.SaveAs Filename:="E:\Macros\Output\Stocks\cm" & Format(Date, "ddmmmyyyy") & "bhav.txt", FileFormat:=xlCSV _
        , CreateBackup:=False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
    ActiveWindow.Close
    ActiveWindow.Close
    
    Application.ScreenUpdating = False
    ChDir "E:\Macros\Input"
    Workbooks.Open Filename:="E:\Macros\Input\fo" & Format(Workbooks("NSE Converter.xls").Sheets("Sheet1").Range("G2").Value, "ddmmmyyyy") & "bhav.csv", Origin:=xlWindows


I would seek the kind help of members to suggest in simplifying this recorded macro

Thanks
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
449
CapRavOr
C
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
273
rlv01
R
P
  • Question Question
Help with Vba Code
Replies
3
Views
476
Coyotex3
C
T
  • Question Question
ActiveSheet. Paste error
Replies
1
Views
351
RoryA
RoryA
R
  • Question Question
VBA for Cut, move, paste, delete rows
Replies
6
Views
269
RForster6
R

Forum statistics

Threads
1,224,551
Messages
6,179,476
Members
452,915
Latest member
hannnahheileen

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top