delete calculated columns

[lefty38]

I have a borrowed VBA Code that will delete columns that = NR ( =IF((K1=0),"NR",(K2/K1)) )
problem is when the cells shift after deleting ==> the code seems to skip over other NR fields


I have attached the code and a small sample of the excel sheet
column range can be from H3 to many columns
calculations are turned off until this practical script runs (to save time)

thank you for any help

Sub deleteNRcolumns()
Dim Rng As Range, cell As Range
'turn on Autocalc so the NR comlumns can be deleted
    Application.ScreenUpdating = True
       With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001

    Set Rng = Range("H3:CA3")
  
        For Each cell In Rng
            Select Case cell.Value
            Case Is = "NR"
                cell.EntireColumn.Delete
        End Select
    Next cell
    
      End With

							4		4	1		4
							4		4	1		4
							100%	NR	100%	100%	NR	100%	NR
Country	State	City	Mgr	Emp	ID	Comp	crs1	crs2	crs3	crs4	crs5	crs6	crs7
				fred	01
				wilma	02
				barny	03
				bam	04

<tbody>
</tbody>

 

[Rick Rothstein]

What about if you don't use a loop at all...

Sub DeleteColumnsEqualToNR()
  Rows(3).Replace "NR", "#N/A", xlWhole, , False, , False, False
  On Error Resume Next
  Rows(3).SpecialCells(xlConstants, xlErrors).EntireColumn.Delete
  On Error GoTo 0
End Sub

 

[lefty38]

Rick , thank you for the code
but for some reason it is not "finding" the "NR"

I referenced out the On error resume next -- it returns an error Run time error '1004' No cells were found

(I added the calculation feature so the row would calculate before deletion (so it can find a % or return an NR in the calculated field)
calculated field for this cell K3 is =IF((K1=0),"NR",(K2/K1)) all of the cells H3:CA3 have this formula (each formula has there own column reference number)

Sub DeleteColumnsEqualToNR()
        Application.ScreenUpdating = True
        Application.Calculation = xlAutomatic
  Rows(3).Replace "NR", #N/A", xlWhole, , False, , False, False
  'On Error Resume Next
  Rows(3).SpecialCells(xlConstants, xlErrors).EntireColumn.Delete
  On Error GoTo 0
End Sub

 

[Fluff]

Try this mod to Rick's code

Sub DeleteColumnsEqualToNR()
        Application.ScreenUpdating = True
        Application.Calculation = xlAutomatic
  Rows(3).Replace "NR", #N/A", [COLOR=#ff0000]xlPart[/COLOR], , False, , False, False
  'On Error Resume Next
  Rows(3).SpecialCells(xlConstants, xlErrors).EntireColumn.Delete
  On Error GoTo 0
End Sub

 

[Rick Rothstein]

Try this mod to Rick's code

Sub DeleteColumnsEqualToNR()
        Application.ScreenUpdating = True
        Application.Calculation = xlAutomatic
  Rows(3).Replace "NR", #N/A", [COLOR=#ff0000]xlPart[/COLOR], , False, , False, False
  'On Error Resume Next
  Rows(3).SpecialCells(xlConstants, xlErrors).EntireColumn.Delete
  On Error GoTo 0
End Sub

That mod won't work Fluff. If NR is in the cell along with other characters, only the NR would be replace with #N/A, but the other characters would remain and those other characters would stop my SpecialCells from working. The way to change my code to handle other possible characters that may be in the cell along with the NR is like this...

Sub DeleteColumnsEqualToNR()
        Application.ScreenUpdating = True
        Application.Calculation = xlAutomatic
  Rows(3).Replace "[B][COLOR="#FF0000"][SIZE=3]*[/SIZE][/COLOR][/B]NR[B][COLOR="#FF0000"][SIZE=3]*[/SIZE][/COLOR][/B]", #N/A", [COLOR="#FF0000"][B]xlWhole[/B][/COLOR], , False, , False, False
  'On Error Resume Next
  Rows(3).SpecialCells(xlConstants, xlErrors).EntireColumn.Delete
  On Error GoTo 0
End Sub

Note to lefty38... if the above code works, then you have other characters in the cells besides the letters NR.

 

[Fluff]

@Rick Rothstein
You're quite right (as normal), in that my mod does not work.
Unfortunately, as the NR is in the middle of a formula, your code will simply delete all the columns with that formula.

 

[Rick Rothstein]

@Unfortunately, as the NR is in the middle of a formula...

#2 ) either. Okay, looking more carefully at this, it appears Row 3 gets its NR value when either Row 1 0 or is blank (within the column range H:CA). Given that, I believe this macro should work...

Sub DeleteColumnsEqualToNR()
  [H1:CA1] = [IF(H1:CA1=0,"",H1:CA1)]
  On Error Resume Next
  [H1:CA1].SpecialCells(xlBlanks).EntireColumn.Delete
  On Error GoTo 0
End Sub

" >@
Apparently, I have had a blind-spot on this fact as I did not take it into account in my first posting (Message #2 ) either. Okay, looking more carefully at this, it appears Row 3 gets its NR value when either Row 1 0 or is blank (within the column range H:CA). Given that, I believe this macro should work...

Sub DeleteColumnsEqualToNR()
  [H1:CA1] = [IF(H1:CA1=0,"",H1:CA1)]
  On Error Resume Next
  [H1:CA1].SpecialCells(xlBlanks).EntireColumn.Delete
  On Error GoTo 0
End Sub

 

[lefty38]

Thanks All,
I will let you know how the code works, "Rick wrote", when i get to work tomorrow

 

[lefty38]

Ok Rick's final code in (message #7 ) does work - but the problem is now, row 5 is a filtered list
and his code turns the formulas in row 1 to hard coded numbers - in which when filtered the formulas do not work
(I hope I am making sense)

the cell in H1 is actually
=SUMPRODUCT(SUBTOTAL(3,OFFSET($F$7:$F$4001,ROW($F7:$F4001)-ROW($F7),,1)),--(ISNA(MATCH(I7:I4001,{"NR"},0))))

the cell in H2 is actually
=SUMPRODUCT(SUBTOTAL(3,OFFSET(H7:H4001,ROW(H7:H4001)-ROW(H7),0,1)),--(H7:H4001="Complete"))

the cell in H3 is actually
=IF((H1=0),"NR",(H2/H1))

Is there a way to turn the ROW H3:CA3 (or how many columns wide from H3)

 [H3:CA3] = [IF(H3:CA3="NR","",H3:CA3)]

to a hard coded "NR" (or percentage) ==> then delete the "NR" column(s)
then re-insert the "=IF((H1=0),"NR",(H2/H1))" back into H3 and the remaining row 3 columns?

						Required	2	0	4	3	0	4	0
						Complete	2	0	4	3	0	3	0
							100%	NR	100%	100%	NR	75%	NR
Country	State	City	Mgr	Emp	ID	Comp	crs1	crs2	crs3	crs4	crs5	crs6	crs7
				fred	1	100%	complete		complete	complete		complete
				wilma	2	100%	NR		complete	complete		complete
				barny	3	50%	NR		complete	NR
				bam	4	100%	complete		complete	complete		complete

<tbody>
</tbody>

 

[lefty38]

Any help?
I hope I didn't add any confusion