Looping Macro

**ExcelGuy160** · 09-14-2010, 12:49 PM

Hello all,

Need a little help writing a macro that will run through a report and change the following:

If Col D = “Open”, then change to “

If Col D = “Open”, then Col E changes to “Y”, Col F changes to “Y” and Col G changes to “N.”

Please see attached workbook DatesReport for before and after versions. Would need this to loop through over 3K rows.

Thanks for any and all help!

**TMS** · 09-14-2010, 02:45 PM

One way:

Sub test()

Application.ScreenUpdating = False
With Range("D2")
    .AutoFilter
    .AutoFilter Field:=4, Criteria1:="OPEN"
End With

For Each cell In Intersect(Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row), _
                           Range("D1").CurrentRegion)
    ' Debug.Print cell.Address
    cell.Value = "SVOD_C_I_W"   ' D
    cell.Offset(0, 1) = "Y"     ' E
    cell.Offset(0, 2) = "Y"     ' F
    cell.Offset(0, 3) = "N"     ' G
Next 'cell
Application.ScreenUpdating = True

End Sub

Regards

**ExcelGuy160** · 09-14-2010, 02:58 PM

Thanks TMshucks,

Unfortunately, this macro deleted all rows except the ones marked "open."

I was trying to keep all rows where they are, just change "Open"

**TMS** · 09-14-2010, 03:11 PM

Deleted ... or hidden?

It shouldn't have deleted anything.

Click on the drop down selection arrow on column D and select all.

Regards

**ExcelGuy160** · 09-14-2010, 05:16 PM

Ah, thanks - these were hidden.

**TMS** · 09-14-2010, 06:37 PM

This is a better version of the code. A little longer but a) it will only change the OPEN lines; b) if you run it twice it doesn't mess up the header; and c) it removes the Autofilter

Sub test()

Application.ScreenUpdating = False
With Range("D2")
    .AutoFilter
    .AutoFilter Field:=4, Criteria1:="OPEN"
End With

If Intersect(Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row), _
                           Range("D1").CurrentRegion, _
                           Range("D1").SpecialCells(xlCellTypeVisible)).Cells.Count = 1 _
Then
    Range("D2").AutoFilter
    Exit Sub
End If

For Each cell In Intersect(Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row), _
                           Range("D1").CurrentRegion, _
                           Range("D1").SpecialCells(xlCellTypeVisible))
    ' Debug.Print cell.Address
    cell.Value = "SVOD_C_I_W"   ' D
    cell.Offset(0, 1) = "Y"     ' E
    cell.Offset(0, 2) = "Y"     ' F
    cell.Offset(0, 3) = "N"     ' G
Next 'cell
Range("D2").AutoFilter

Application.ScreenUpdating = True

End Sub

Regards