I've only started to learn macro.
I need to work on a spreadsheet everyday (different number of rows) to basically do the following:
1) In worksheet "Combined", find the total amount of "deposits" for each account (column "J") and also total number of items on deposit (column "M").
2) Copy the results from above to another worksheet "Results" with the same headings.
With no knowledge with VBA, I managed to record a macro that works, but very slow because I have to assume a maximum of 20,000 rows of data, so I had to copy everything down the 20,000 rows and calculations are done for 20,000 rows.
Below is the recorded macro, any suggestion that can make this run faster would be much appreciated (the last few lines are VBA codes I found via Google and added to my reocrded codes):
I need to work on a spreadsheet everyday (different number of rows) to basically do the following:
1) In worksheet "Combined", find the total amount of "deposits" for each account (column "J") and also total number of items on deposit (column "M").
2) Copy the results from above to another worksheet "Results" with the same headings.
With no knowledge with VBA, I managed to record a macro that works, but very slow because I have to assume a maximum of 20,000 rows of data, so I had to copy everything down the 20,000 rows and calculations are done for 20,000 rows.
Below is the recorded macro, any suggestion that can make this run faster would be much appreciated (the last few lines are VBA codes I found via Google and added to my reocrded codes):
Code:
Sub Convert()
'
' Convert Macro
'
'
Sheets("Combined").Select
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Columns("J:J").Select
Selection.Replace What:="~*", Replacement:="#", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="~?", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("N2").Select
ActiveCell.FormulaR1C1 = "=RC[-10]&"",""&RC[-5]&"",""&RC[-4]"
Range("N2").Select
Selection.Copy
Range("N20001").Select
Range("N3:N20001").Select
Range("N20001").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("N:N").Select
Range("N20001").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("N2:N20001").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"O2"), Unique:=True
Range("P2").Select
ActiveCell.FormulaR1C1 = "=SUMIF(C[-2],RC[-1],C[-4])"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=SUMIF(C[-3],RC[-2],C[-4])"
Range("P2:Q2").Select
Selection.Copy
Range("P3").Select
Range("P3:Q20001").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("P:Q").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-2]>0,""True"",""False"")"
Range("R2").Select
Selection.Copy
Range("R3").Select
Range("R3:R20001").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("R:R").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("J:J").Select
Selection.Replace What:="/", Replacement:="?", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="#", Replacement:="*", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("R2").Select
Application.CutCopyMode = False
Columns("P:P").Select
Selection.NumberFormat = "#,##0.00"
Columns("Q:Q").Select
Selection.NumberFormat = "#,##0"
Range("R2").Select
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = ActiveWorkbook.Worksheets("Combined")
Set Target = ActiveWorkbook.Worksheets("Results")
j = 2 ' Start copying to row 2 in target sheet
For Each c In Source.Range("R3:R20001")
If c = "True" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Sheets("Convert").Select
Range("C3").Select
End Sub
Last edited by a moderator:
