VBA：在找到的单元格之前插入新行

Question

Below is the code that I'm running, I'm not too sure if I can get what I want.
But strangely, the code is taking too long to run.
I was waiting for it for an hour.
So I figured there must be some errors in the code.
Can anybody shed some light on this?

Set x = Workbooks.Open("C:\Users\Desktop\testing.xlsx")

For Each ws In x.Worksheets
If ws.Name <> "Master" Then
    lrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = ws.Range(Cells(1, 1), Cells(lrow, 1))
    For Each Acell In rng
        If (Acell.Value = "Sum") Then
            Acell.Offset(-1, 0).EntireRow.Insert
        End If
    Next Acell
End If
Next ws

I'm looking for that "Sum" word in Col A, for every sheets in workbook except "master" sheet.

Answer 1

When you insert a row and then continue with the loop you will end up on a "Sum"-row again (it has been pushed one row down due to the Insert). Therefore your code will insert row after row after row after row... forever

Try this code (inside the If)... not the best solution perhaps, but it works:

lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
R = 1
Do Until R > lastrow
    If (ws.Cells(R, 1).Value = "Sum") Then
        ws.Cells(R, 1).EntireRow.Insert
        R = R + 1             ' Jump one extra step (to skip the inserted row)
        lastrow = lastrow+ 1  ' The last row is increased due to the inserted row
    End If
    R = R + 1
Loop

Answer 2

Since there is only 1 sum in a column

Set x = Workbooks.Open("C:\Users\Desktop\testing.xlsx")

For Each ws In x.Worksheets
If ws.Name <> "Master" Then
    lrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = ws.Range(Cells(1, 1), Cells(lrow, 1))
    For Each Acell In rng
        If (Acell.Value = "Sum") Then
            Acell.Offset(-1, 0).EntireRow.Insert
        exit for
        End If
    Next Acell
End If
Next ws

try this code.

Answer 3

You are looping through the worksheets but not using each individual worksheet as the parent worksheet to the cells. Without a qualified parent worksheet, each Cells simply defaults to the ActiveSheet.

For Each ws In x.Worksheets
    If ws.Name <> "Master" Then
        with ws
            lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rng = .Range(.Cells(1, 1), .Cells(lrow, 1))
            For Each Acell In rng
                If Acell.Value = "Sum" Then
                    Acell.Offset(-1, 0).EntireRow.Insert
                End If
            Next Acell
        end with
    End If
Next ws

Note that you are starting in row 1 and if A1 is Sum then you are trying to insert a row at row 0. There is no row zero.

Answer 4

Instead of the For Each loop use a For i = lRow to 1 Step -1 and then use i to access each row: If ws.Cells(i, 1) = "Sum" Then ws.Rows(i).Insert .

When looping from the bottom, then inserting/deleting rows doesn't affect rows above (which are not processed yet) but just rows below (which are already processed).

Dim iRow As Long, lRow As Long
Dim ws As Worksheet
Dim x As Workbook

Set x = Workbooks.Open("C:\Users\Desktop\testing.xlsx")

For Each ws In x.Worksheets
    If ws.Name <> "Master" Then
        lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        For iRow = lRow To 1 Step -1 'walk through rows from last row (lRow) to first row going upwards (Step -1)
            If ws.Cells(iRow, 1) = "Sum" Then
                ws.Rows(iRow).Insert xlDown 'insert new row and move other rows down
                Exit For  'if there is only one "Sum" you can exit for here (to shorten the run time) 
                          'if there are more that one "Sum" in a sheet then remove that line.
            End If
        Next iRow
    End If
Next ws

Answer 5

Have you tried setting Workbook Calculation to Manual, i found this helpful since I tend to work with workbooks with a load of sheets an every sheets has a load of formulas.

File>Options>Formulas

then set Workbook Calculations to manual, but if you want to automate this.

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+e
'
    calcu
    'your code here

    ActiveWorkbook.Application.Calculation  = xlCalculationAutomatic

End Sub

'=

Function calcu()

    Dim xlCalc As XlCalculation

    xlCalc = Application.Calculation
    ActiveWorkbook.Application.Calculation = xlCalculationManual
    On Error GoTo CalcBack
    Exit Function

CalcBack:
    ActiveWorkbook.Application.Calculation = xlCalc

End Function

I got this from somewhere in stack but I forgot which post, so if you're the one who did this, thanks. :)