I am using a VBA macro to insert a column whereby it searches for a text character in column A.
My code runs correctly. However, the file appears like it is going to crash. I will be building on the macro and want it to run smoothly.
Is there a way to optimise my code
Code:
Sheets("Annual Rec").Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.NumberFormat = "General"
Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row).Formula = "=ISTEXT(RC[-1])"
Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
The code below does the same as yours, just without the unnecessary Select and Selection.
Option Explicit
Sub CopyColPasteVal()
Application.ScreenUpdating = False
With Sheets("Annual Rec")
.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Columns("B:B").NumberFormat = "General"
With .Range("B2:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
.Formula = "=ISTEXT(RC[-1])"
.Copy
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
Try this:
Application.ScreenUpdating = False
'your code
Application.ScreenUpdating = True
And avoid Select statements, they are quite slow.
Related
I'm trying to SUM these values
And this is what happens after I run the macro.
I'm having trouble with the following problem, I'm trying to build a macro to combine corresponding values in column A and then SUM the values in column B.
I've tried the following code, which deletes the duplicates in column A but does nothing or very little with column B.
Sub RemoveDupsAndSumUp()
Application.ScreenUpdating = False
Columns("A:A").Copy
Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("$C:$C").RemoveDuplicates Columns:=1, Header:=xlNo
Range("D1").FormulaR1C1 = "=SUMIF(C[-3],RC[-1],C[-2])"
Range("D1").AutoFill Destination:=Range("D1:D" & Range("C" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault
Application.ScreenUpdating = True
End Sub
The code below worked for me quite nicely, producing what is intended:
Sub TestMe()
With ActiveSheet
.Columns("C:D").ClearContents
.Columns("A:A").Copy
.Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.Range("$C:$C").RemoveDuplicates Columns:=1, Header:=xlNo
.Range("D1").FormulaR1C1 = "=SUMIF(C[-3],RC[-1],C[-2])"
.Range("D1").AutoFill Destination:=Range("D1:D" & Range("C" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault
End With
End Sub
Seems you may be trying to conditionally sum Text.
I'm a beginner, so any help is much appreciated, I want to combine this macro with the first code, but I don't know how to do that or where to put it.
this is the first code (it has a mistake in it, but I already have an answer on how to fix it, so it's alright):
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("inbd")
Dim wsDestination As Worksheet: Set wsDestination = Sheets("test")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A1:N" & LastRow).AutoFilter Field:=1, Criteria1:=Worksheets("test").Cells(1, 26).Value
ws.Range("f2:f" & LastRow).SpecialCells(xlCellTypeVisible).Copy Range("C6")
DestinationRow = wsDestination.Cells(wsDestination.Rows.Count, "C").End(xlUp).Row + 1
wsDestination.Range("C" & DestinationRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ws.Range("A1:N" & LastRow).AutoFilter Field:=1
End Sub
currently the first code filters and copies table data in the parameter that I want into another worksheet, but I need a more complex version of the copy so I recorded it in macro, which is super long and looks like this:
Sub Macro8()
'
' Macro8 Macro
'
'
Sheets("INBD").Select
Range("Table1[Description]").Select
Selection.Copy
Sheets("Sheet1").Select
Range("Table19[Description]").Select
ActiveSheet.Paste
Range("D18").Select
Sheets("INBD").Select
Range("Table1[Invoice Date]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("Table19[Invoice '#]").Select
ActiveSheet.Paste
Sheets("INBD").Select
Range("Table1[Invoice '#]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("Table19[Invoice '#]").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("INBD").Select
Range("Table1[HS Code]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("Table19[HS Code]").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("INBD").Select
Range("Table1[Unit]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("Table19[M. Unit]").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("Table19[Description]").Select
Application.CutCopyMode = False
Selection.Copy
Range("E13").Select
ActiveSheet.Paste
Sheets("INBD").Select
Range("Table1[QTY]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("Table19[QTY]").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("INBD").Select
Range("Table1[Unit Price]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("Table19[Unit Price]").Select
ActiveSheet.Paste
Sheets("INBD").Select
Range("Table1[Curr.]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("Table19[Curr]").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Rows("13:22").Select
Rows("13:22").EntireRow.AutoFit
Selection.RowHeight = 30
Application.CutCopyMode = False
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
What this does is that it copies values into a table, into specific columns, below the table I wrote in a bunch of stuff and made the color of the font white, so that when it copies, the table moves the cells down hence not altering anything below the table and leaves some space in between. After this I'm going to record a macro which deletes all rows in the table and any other data in the table to clear the document for a new entry.
One solution to combine two Macros would be just to type everything from the second Macro between the first and last line and paste in where you need its execution in the first code.
The other solution would be to "Call" the second Macro from the first Code by simply typing
Call Macro8
In your example :
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("inbd")
Dim wsDestination As Worksheet: Set wsDestination = Sheets("test")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A1:N" & LastRow).AutoFilter Field:=1, Criteria1:=Worksheets("test").Cells(1, 26).Value
ws.Range("f2:f" & LastRow).SpecialCells(xlCellTypeVisible).Copy Range("C6")
DestinationRow = wsDestination.Cells(wsDestination.Rows.Count, "C").End(xlUp).Row + 1
wsDestination.Range("C" & DestinationRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ws.Range("A1:N" & LastRow).AutoFilter Field:=1
Call Macro8 ' Or Copy Paste the whole other code here
End Sub
I still strongly advise to follow the links from the comments of Foxfire And Burns And Burns about How to avoid using Select in Excel VBA.
Application.run ("macro8") <-is what I needed, I appreciate the advice though, I don't really have any knowledge in coding, but I will try to avoid using select if i can.
I have a VBA code as you can see below, I recorded it. While recording it, it wrote the formula in offset format. So I don't know how to change the range
How can I convert;
R3C[-3]:R[1488]C[2] which is normally B$3:G1489
to:
B$3:(last active cell in column "G")
How can I do that?
Sub duzenle()
Columns("E:E").Select
Selection.Copy
Range("L1").Select
ActiveSheet.Paste
Range("E12").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],C.A.!R3C[-3]:R[1488]C[2],4,0),IF(ISBLANK('2017'!RC[7]),"""",'2017'!RC[7]))"
Range("E12").Select
Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown)), Type:=xlFillDefault
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Columns("E:E").Select
Selection.Copy
Range("E1").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
MsgBox "'C.A' Degerleri Guncellenmistir."
End Sub
You can remove some of your unnecessary Select, Selection and by replacing the first few code lines of yours:
Columns("E:E").Select
Selection.Copy
Range("L1").Select
ActiveSheet.Paste
With:
Columns("E:E").Copy Range("L1")
Regarding your formula, you need to replace FormulaR1C1 with Formula, see code below:
With Worksheets("C.A.")
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row '<--get last row with data in Column G from "C.A." sheet
End With
Range("E12").Formula = _
"=IFERROR(VLOOKUP(B3,C.A.!B$3:G" & LastRow & ",4,0)...' <-- the rest of your formula
Edit 1: just corrected the Formula code line:
Range("E12").Formula = "=IFERROR(VLOOKUP(B3,C.A.!B$3:G" & LastRow & ",4,0),IF(ISBLANK('2017'!L12)," & Chr(34) & Chr(34) & ",'2017'!L12))"
How can i make my code go faster?
It's go real slow when the Vlookup is active and i don't know how to make it go fast.
It takes more than 2 minute and it's the same as doing manually.
Sub
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Select
ActiveCell.FormulaR1C1 = "KEY"
Range("I1").Select
ActiveCell.FormulaR1C1 = "CHECK"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=RC[7]&RC[12]&RC[16]"
Range("J2").Select
Selection.AutoFill Destination:=Range("j2:j" & cells(Rows.Count, "a").End(xlUp).Row)
Sheets("CSI Plans Report").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Application.Calculation = xlManual
Sheets("CSI Plan ww").Select
Range("J1:N1").Select
Selection.Copy
Sheets("CSI Plans Report").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter
Range("A2").Select
ActiveCell.FormulaR1C1 = "=RC[7]&RC[12]&RC[16]"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'CSI Plan ww'!C[8]:C[12],2,0)"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'CSI Plan ww'!C[7]:C[11],3,0)"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],'CSI Plan ww'!C[6]:C[10],4,0)"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'CSI Plan ww'!C[5]:C[9],5,0)"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & cells(Rows.Count, "f").End(xlUp).Row)
Range("B2").Select
Selection.AutoFill Destination:=Range("b2:b" & cells(Rows.Count, "f").End(xlUp).Row)
Range("C2").Select
Selection.AutoFill Destination:=Range("c2:c" & cells(Rows.Count, "f").End(xlUp).Row)
Range("D2").Select
Selection.AutoFill Destination:=Range("d2:d" & cells(Rows.Count, "f").End(xlUp).Row)
Range("E2").Select
Selection.AutoFill Destination:=Range("e2:e" & cells(Rows.Count, "f").End(xlUp).Row)
Application.Calculation = xlAutomatic
Range("A:E").Select
Range("A:E").Copy
Range("A:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("CSI Plan ww").Select
Range("I2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[1],'CSI Plans Report'!C[-8]:C[-3],6,0)"
Range("I2").Select
Selection.AutoFill Destination:=Range("i2:i" & cells(Rows.Count, "a").End(xlUp).Row)
Columns("I:J").Copy
Columns("I:J").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
This:
Range("A:E").Select
Range("A:E").Copy
Range("A:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
can be written as just:
Range("A:E").Value = Range("A:E").Value
to achieve best performance in excel VBA try to not use Select.
instead of
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & cells(Rows.Count, "f").End(xlUp).Row)
better use this
Range("A2").AutoFill Destination:=Range("A2:A" & cells(Rows.Count, "f").End(xlUp).Row)
And best what you can do is to specify sheet too (but it has nothing to do with performance, its just good practice)
Sheets("someSheetName").Range("A2").AutoFill Destination:=Range("A2:A" & cells(Rows.Count, "f").End(xlUp).Row)
And i strongly recomend to use on begining of your sub
application.screenUpdating = false
and this on end of your sub
application.screenUpdating = true
So your excel wont show any change imediately, but at once at the end of the code. (you can read more about screenUpdating almost everywhere on web)
I think this can make you some performance boost.
If you turn off calculation you will save significant periods of time that would otherwise be devoted to calculating formulas that are only oin to be recalculated later.
If you put your formulas into all the rows at once, you do not have to have the calculation on; if you put them into a single cell and fill down you need to run a calculation cycle.
Anytime you can do multiple things at once is better than doing things repeatedly.
Everyone will tell you to read this. It is good advice.
Here's is my contribution to the rewrite process.
Option Explicit
Sub sonic()
Dim lr As Long
'uncomment the next line when you have completed debugging
'appTGGL bTGGL:=False 'see appTGGL helper sub below for details on suspending the enviroment
With Worksheets("CSI Plan ww") '<~~you should know what worksheet you are on!!
'don't insert a sinle column twice - insert 2 columns
.Columns("I:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'never do something twice when you do two things at once
.Range("I1:J1") = Array("CHECK", "KEY")
'write all of the formulas at once
.Range(.Cells(2, "J"), .Cells(Rows.Count, "A").End(xlUp).Offset(0, 9)). _
FormulaR1C1 = "=RC17&RC22&RC26"
End With
With Worksheets("CSI Plans Report")
'again - all at once
.Columns("A:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'no need to select to make a copy
Worksheets("CSI Plan ww").Range("J1:N1").Copy _
Destination:=.Range("A1")
'collect the last row so it doesn't have to be repeatedly looked up
lr = .Cells(Rows.Count, "F").End(xlUp).Row
'each column's formulas all at once
.Range("A2:A" & lr).FormulaR1C1 = "=RC8&RC13&RC17"
.Range("B2:B" & lr).FormulaR1C1 = "=VLOOKUP(RC1,'CSI Plan ww'!C10:C14, 2, 0)"
.Range("C2:C" & lr).FormulaR1C1 = "=VLOOKUP(RC1,'CSI Plan ww'!C10:C14, 3, 0)"
.Range("D2:D" & lr).FormulaR1C1 = "=VLOOKUP(RC1,'CSI Plan ww'!C10:C14, 4, 0)"
.Range("E2:E" & lr).FormulaR1C1 = "=VLOOKUP(RC1,'CSI Plan ww'!C10:C14, 5, 0)"
.Range("A2:E" & lr) = .Range("A2:E" & lr).Value2 'use .Value if any of these are dates
End With
With Worksheets("CSI Plan ww")
.Range(.Cells(2, "I"), .Cells(Rows.Count, "A").End(xlUp).Offset(0, 8)). _
FormulaR1C1 = "=VLOOKUP(RC10,'CSI Plans Report'!C1:C6, 6, 0)"
'collect the last row so it doesn't have to be repeatedly looked up
lr = .Cells(Rows.Count, "J").End(xlUp).Row
'revert formulas to values
.Range("I2:J" & lr) = .Range("I2:J" & lr).Value2 'use .Value if any of these are dates
End With
appTGGL 'turn everything back on
End Sub
Public Sub appTGGL(Optional bTGGL As Boolean = True)
With Application
.ScreenUpdating = bTGGL
.EnableEvents = bTGGL
.DisplayAlerts = bTGGL
.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
.CutCopyMode = False
.StatusBar = vbNullString
End With
Debug.Print Timer
End Sub
What I usually do, when writing macros is the following:
Public Sub MyMainMacro
Call OnStart
'Here comes the code
Call OnEnd
End Sub
Public Sub OnStart()
Application.ScreenUpdating = False
Application.Calculation = xlAutomatic
Application.EnableEvents = False
End Sub
Public Sub OnEnd()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.StatusBar = False
End Sub
My program works by calling a number of macros as such:
Sub Start()
Call ClearAll
Call Sales_Download
Call Copy_Sales
Call Receipt_Download
Call Copy_Receipt
Call Copy1
Call Sales_Summary
Call Copy2
Call Receipt_Summary
End Sub
My program breaks at the copy2, which is essentially an exact replica of copy1 wich works fine. When copy2 is ran by itself it works perfectly, but when I attempt to run the entire program it debugs. The bolded line is where the debug happens.
Sub Copy2()
' Copies all data from Receipt Download tab for each location, and saves in a seperate folder
Dim i As Long
Dim lngLastRow As Long, lngPasteRow As Long
'Find the last row to search through
lngLastRow = Sheets("Receipt_Download").Range("J65535").End(xlUp).Row
'Initialize the Paste Row
lngPasteRow = 2
Dim rng As Range
Dim c As Range
Dim endrow
Dim strName As String
Dim ws As Worksheet
Dim j As Long
endrow = Sheets("names").Range("A65000").End(xlUp).Row
Set rng = Sheets("names").Range("A2:A" & endrow)
j = 1
FBO = strName
For Each c In rng
For i = 2 To lngLastRow
strName = c.Value
If Sheets("Receipt_Download").Range("J" & i).Value = strName Then
Sheets("Receipt_Download").Select
Range("A" & i & ":IV" & i).Copy
Sheets("Summary").Select
Range("A" & lngPasteRow & ":IV" & lngPasteRow).Select
ActiveSheet.Paste
lngPasteRow = lngPasteRow + 1
End If
Next i
j = j + 1
Sheets("Receipt_Download").Select
Rows("1:1").Select
Selection.Copy
Sheets("Summary").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("D:E").Select
Selection.NumberFormat = "m/d/yyyy"
Sheets("Summary").Select
Range("B25000").Select
ActiveCell.FormulaR1C1 = "Grand Total"
Range("B25000").Select
Selection.Font.Bold = True
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])"
Range("G1").Select
Selection.AutoFill Destination:=Range("G1:G24950")
Range("G25000").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)"
Range("G25000").Select
Selection.Copy
Range("F25000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Sheets("Summary").Select
Range("F25000").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Names").Select
With Columns("B")
.Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With
ActiveSheet.Paste
Sheets("Summary").Select
Range("b1:b30000").Select
For Each Cell In Selection
If Cell.Value = "" Then
Cell.ClearContents
End If
Next Cell
Range("b1:b30000").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("Summary").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Names").Select
***With Columns("C")
.Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate***
End With
ActiveSheet.Paste
Sheets("Summary").Select
Range("A1:Z5000").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
File = "C:\Documents and Settings\user\Desktop\New FBO\" & strName & "\" & strName & " Receipts.xls"
ActiveWorkbook.SaveAs Filename:=File, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
IngPasteRow = IngPasteRow + 1
Sheets("Summary").Select
Selection.ClearContents
Next c
End Sub
I would really appreciate any help, I am certainly no VBA master and this has been quite troublesome.
Replace this part of your code
Sheets("Summary").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Names").Select
With Columns("C")
.Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With
ActiveSheet.Paste
with
Dim lRow As Long
With Sheets("Names")
lRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1
Sheets("Summary").Range("D2").Copy .Range("C" & lRow)
End With
Now try it.
Also few tips
Avoid .Select and .Activate They are a major cause of errors
Indent and appropriately comment your code. Your code is very difficult to read. If you don't indent/comment your code, you will realize that you will not recognize your OWN code if you visit it say after a week :)
In support of Siddharth's answer above, I have take a portion of your code (up to where your break happens) and have indented and avoided the .Select and .Activate that he mentions. Hopefully this gives you a good start on how to make your code more readable for debugging and understanding.
For Each c In rng
For i = 2 To lngLastRow
strName = c.Value
If Sheets("Receipt_Download").Range("J" & i).Value = strName Then
Sheets("Receipt_Download").Range("A" & i & ":IV" & i).Copy _
Destination:=Sheets("Summary").Range("A" & lngPasteRow & ":IV" & lngPasteRow)
lngPasteRow = lngPasteRow + 1
End If
Next i
j = j + 1
Sheets("Receipt_Download").Rows("1:1").Copy Destination:=Sheets("Summary").Rows("1:1")
With Sheets("Summary")
.Columns("D:E").NumberFormat = "m/d/yyyy"
With .Range("B25000")
.Formula = "Grand Total"
.Font.Bold = True
End With
.Columns("G:G").Insert Shift:=xlToRight
With Range("G1")
.FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])"
.AutoFill Destination:=Range("G1:G24950")
End With
With ("G25000")
.FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)"
.Copy
End With
.Range("F25000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Columns("G:G").Delete Shift:=xlToLeft
.Range("F25000").Copy Destination:=Sheets("Names").Columns("B").Find(what:="", after:=Sheets("Names").Cells(1, 1), LookIn:=xlValues)
End With