shorten vba of repetitive task

[LFKim2018]

I want to store the SUB below in a module then to call it from anywhere so that I don't have to write the code over and over again...

My problem is how/what to declare of the variables (in the SUB line)
THEN when this sub is called, it will be as below:

SUB SortSubtotal("client", "C2:C",3)
SUB SortSubtotal("item", "D2:D",4)
etc...


SUB SortSubtotal(mitem as variant?, md2d as variant?, m4 as long?)

note: Those hi-lighted (RED) below are to be replaced by variables (above)
"item" = mitem (worksheet name)
"D2:D" = mdsd (range)
4 = m4 (column number)
1 to 19 below is the repetetive task

1. Sheets("item").Select
2. Sheets("item").Range("A2").Select
3. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
4. :=False, Transpose:=False
5. Application.CutCopyMode = False
6. ActiveWorkbook.Worksheets("item").Sort.SortFields.Clear
7. ActiveWorkbook.Worksheets("item").Sort.SortFields.Add Key:=Range("D2:D" & LastRow), _
8. SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
9. With ActiveWorkbook.Worksheets("item").Sort
10. .SetRange Range("A1:J" & LastRow)
11. .Header = xlYes
12. .MatchCase = False
13. .Orientation = xlTopToBottom
14. .SortMethod = xlPinYin
15. .Apply
16. End With
17. Sheets("item").Range("A1:J" & LastRow).Select
18. Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(7), _
19. Replace:=True, PageBreaks:=False, SummaryBelowData:=True

End Sub


I hope I explained it clearly.
many many thanks

 

[PhilS2520]

Hi LFKim2018,

What you need to do is store the code in the personal.xlsb workbook. I am not near my computer at the moment, but I am sure that when you start the code recorder, you will get a dialog box that allows you to pick where to store the code. The default option is Thisworkbook. The personal.xlsb workbook is a hidden one that is opened when you start Excel making the code in it accessible to all workbooks.

Looking at your code, it seems to me that you are doing a lot of selecting, which is very slow. Try and revise the Select statements to get them down to the absolute minimum.

Let me know if you need any more help.

 

[LFKim2018]

Hi LFKim2018,

What you need to do is store the code in the personal.xlsb workbook. I am not near my computer at the moment, but I am sure that when you start the code recorder, you will get a dialog box that allows you to pick where to store the code. The default option is Thisworkbook. The personal.xlsb workbook is a hidden one that is opened when you start Excel making the code in it accessible to all workbooks.

Looking at your code, it seems to me that you are doing a lot of selecting, which is very slow. Try and revise the Select statements to get them down to the absolute minimum.

Let me know if you need any more help.

Mr PhilS2520
Thank you for your reply. Actually the codes I made was derived by recording macros and it is already working in my workbook (xlsm). It just looked messy and massive as the codes have to be repeated for several worksheets. I just want it to be shorter by calling on the SUB wherever needed. many thanks

 

[LFKim2018]

correction:

SUB SortSubtotal("client", "C2:C",3)
SUB SortSubtotal("item", "D2:D",4)

the above should read:

SortSubtotal("client", "C2:C",3)
SortSubtotal("item", "D2:D",4)

many thanks

 

[LFKim2018]

I want to store the SUB below in a module then to call it from anywhere so that I don't have to write the code over and over again...

My problem is how/what to declare of the variables (in the SUB line)
THEN when this SUB is called, it will be as below:

SortSubtotal("client", "C2:C",3)
SortSubtotal("item", "D2:D",4)
etc...


SUB SortSubtotal(mitem as variant?, md2d as variant?, m4 as long?) <-- SUB line

note: Those hi-lighted (RED) below are to be replaced by variables (above)
"item" = mitem (worksheet name)
"D2:D" = mdsd (range)
4 = m4 (column number)
1 to 19 below is the repetetive task

1. Sheets("item").Select
2. Sheets("item").Range("A2").Select
3. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
4. :=False, Transpose:=False
5. Application.CutCopyMode = False
6. ActiveWorkbook.Worksheets("item").Sort.SortFields.Clear
7. ActiveWorkbook.Worksheets("item").Sort.SortFields.Add Key:=Range("D2:D" & LastRow), _
8. SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
9. With ActiveWorkbook.Worksheets("item").Sort
10. .SetRange Range("A1:J" & LastRow)
11. .Header = xlYes
12. .MatchCase = False
13. .Orientation = xlTopToBottom
14. .SortMethod = xlPinYin
15. .Apply
16. End With
17. Sheets("item").Range("A1:J" & LastRow).Select
18. Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(7), _
19. Replace:=True, PageBreaks:=False, SummaryBelowData:=True

End Sub


I hope I explained it clearly.
many many thanks

 

[LFKim2018]

Mr. Wyn Hopkins assisted me with this vba, and I would like to share this with anyone who might have the same scenario.


Sub AnalyzeData()


Call Module1.SortSubtotal("client", "C2:C", 3)
Call Module1.SortSubtotal("item", "D2:D", 4)
Call Module1.SortSubtotal("class", "F2:F", 6)
Call Module1.SortSubtotal("status", "H2:H", 8)
Call Module1.SortSubtotal("resolve", "J2:J", 10)

End Sub


Sub SortSubtotal(msheet As Variant, mrng As String, mcol As Integer)


Sheets("RaD").Select
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A2:J" & LastRow).Select
Selection.Copy
Sheets(msheet).Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets(msheet).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(msheet).Sort.SortFields.Add Key:=Range(mrng & LastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(msheet).Sort
.SetRange Range("A1:J" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:J" & LastRow).Select
Selection.Subtotal GroupBy:=mcol, Function:=xlSum, TotalList:=Array(7), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

End Sub