Member Avatar for phdbd

Hello,
Today I put together some code for a VB macro, but, having tried different methods I can't get it to loop. The closest I could come was getting my 1st copy paste to do so infinitely. I'm trying to get it to copy the department name in front of every entry for that department, delete the subtotal Rows and the copy the next department name etc.

Range("A5").Select

If ActiveCell <> "" Then
ActiveCell.Select
Selection.Copy
        'If the cell has a Department, copy it'
ActiveCell.Offset(1, 0).Select
If ActiveCell = "" Then
         ActiveSheet.Paste
         'paste the department numbers on the rows without it.'

ElseIf ActiveCell Like "Totals*" Then
 Rows(ActiveCell.Row).delete
    'delete the Company Totals Rows'
    ActiveCell.Select
    
End If
 
End Sub

Thanks

  • 2 Contributors
  • 2 Replies
  • 301 Views
  • 5 Days Discussion Span
  • Latest Post Latest Post by aktharshaik

Dani AI

Generated

A concise, more resilient pattern that avoids Select/Clipboard and the usual row-skipping/infinite-loop pitfalls. described the goal (fill down department names and remove subtotal rows); ’s For-loop idea is on the right track, but adjusting the loop limit after a delete is fragile. Scanning from the last used row up to the header row keeps indexes stable, lets a single variable hold the current department, and deletes safely without recalculating row counts.

Example macro (works on the ActiveSheet; run on a copy first):

Sub FillDepartmentsAndRemoveTotals()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim r As Long
    Dim currentDept As String
    Dim cellText As String

    Set ws = ActiveSheet
    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For r = lastRow To 5 Step -1
            cellText = Trim(CStr(.Cells(r, "A").Value))
            If cellText = "" Then
                .Cells(r, "A").Value = currentDept
            ElseIf LCase(Left(cellText, 6)) = "totals" Then
                .Rows(r).Delete
            Else
                currentDept = cellText
            End If
        Next r
    End With
End Sub

Notes and quick checks: enable Option Explicit, run on a backup, and trim/case-normalize because "Totals" rows may have extra spaces or different casing. For large sheets, wrap with Application.ScreenUpdating = False and restore it at the end. If department cells are formulas or merged, convert/unmerge before running. This bottom-up direct-assignment approach is faster, avoids clipboard side effects, and handles deletions without changing loop bounds.

Recommended Answers

All 2 Replies

Member Avatar for aktharshaik

The Range() uses a string for selection of a range of cells.

you can use like this for eg:

Dim i as integer
Dim n as integer

n = 100        'The last row

For i = 5 to n
    Range("A" & i).Select
    If ActiveCell <> "" Then
         ActiveCell.Select
         Selection.Copy
         'If the cell has a Department, copy it'
         ActiveCell.Offset(1, 0).Select
         If ActiveCell = "" Then
              ActiveSheet.Paste
              'paste the department numbers on the rows without it.'
         ElseIf ActiveCell Like "Totals*" Then

              'delete the Company Totals Rows'
              Rows(ActiveCell.Row).delete

             'Decrease the last row count
             'because a row is deleted
             n = n - 1

              ActiveCell.Select
          End If
    End If
Next i
Member Avatar for aktharshaik

Check out the Example attached.


Regards
Shaik Akthar

LOOPING.zip (10.67 KB)
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.