VBA code runs two loops very slow - performance

Question

I have this code which runs two loops after each other. It works fine for a few thousand rows. But as the number of rows increases, the code runs significantly longer. It should loop over 100.000 rows but this will take hours and hours.
Please let me know if you see a reason why this code is taking so long
Sub BSIS()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lngRow As Long
Dim counter As Long
'Merge rows with duplicate Cells
With ActiveSheet
.Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes 'change this to xlYes if your table has header cells
For lngRow = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If ActiveSheet.Cells(lngRow - 1, 1) = ActiveSheet.Cells(lngRow, 1) Then
.Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4) + .Cells(lngRow, 4)
.Rows(lngRow).Delete
End If
Next lngRow
End With
'Delete rows with negative cells
With ActiveSheet
For counter = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If ActiveSheet.Cells(counter, 4) <= 0 Then
.Rows(counter).Delete
End If
Next counter
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Answer 1

one option would be copying the range of data you want to examine into an array. Do what ever data processing you want with that array, then copy the results back into the excel sheet. Here is an example:
Dim i As Integer
Dim j As Integer
Dim flagMatch As Boolean
Dim arrData2Search As Variant
Set arrData2Search = Range(Cells(1, 1), Cells(1000, 2000)).value
flagMatch = False
For j = 1 To 1000
For i = 1 To 2000
If arrData2Search (i, j)= "Target" Then
flagMatch = True
End If
Next i
Next j

Answer 2

The reason for slow run is that you are deleting rows one by one.
It always better to do it in single shot using UNION function
Try the below code it should work,(Tested)
Dim uni As Range
With ActiveSheet
.Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes
For lngRow = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If ActiveSheet.Cells(lngRow - 1, 1) = ActiveSheet.Cells(lngRow, 1) Then
.Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4) + .Cells(lngRow, 4)
If Not uni Is Nothing Then
Set uni = Application.Union(uni, Range(.Rows(lngRow).Address))
Else
Set uni = Range(.Rows(lngRow).Address)
End If
End If
Next lngRow
uni.Delete
End With

Answer 3

There are a number of ways to optimize performance of one's VBA code, and a good number of articles and forums have covered the topic. For a great resource, see this.
One of the main things to remember is that every time your code interacts with the UI of Excel, it uses much more overhead than if the interaction had not occurred. That's why (to VBA Programmer's point) it's much faster to load the data to an array, perform your calculations, and then write the array back to a sheet. And that's why (to Sathish's point) it's much faster to delete all the rows at once (one interaction) compared to each one individually (multiple interactions). For more information about deleting rows, see this.
With regards to your code, is there any particular reason you need two loops?
Untested
Sub BSIS()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lngRow As Long
Dim r As Range
With ActiveSheet
.Cells(1).CurrentRegion.Sort key1:=.Cells(1), HEADER:=xlYes 'change this to xlYes if your table has header cells
'One loop:
For lngRow = .UsedRange.Rows.Count To 2 Step -1
'Merge rows with duplicate Cells
If .Cells(lngRow - 1, 1) = .Cells(lngRow, 1) Then
.Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4) + .Cells(lngRow, 4)
If r Is Nothing Then
Set r = .Cells(lgnrow, 1)
Else: Set r = Union(r, .Cells(lgnrow, 1))
End If
'Delete rows with negative cells
If .Cells(lngRow, 4) <= 0 Then
If r Is Nothing Then
Set r = .Cells(lngRow, 1)
Else: Set r = Union(r, .Cells(lgnrow, 1))
End If
Next lngRow
End With
'Delete rows
r.EntireRow.Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub