delete column sets current cell wrong

[davegb]

I have code that looks at the column headers in a sheet and in some
cases, deletes the column, in others, replaces the header with a
different one, based on a table of old header values and new header
values in a different workbook. The problem is, that as the macro goes
through the range (rTtl), when a column is deleted, it skips the column
to the deleted columns right and continues. In other words, rCell is
one cell to the right of where I want it to be after a column is
deleted. How do I "back up" rCell one cell to the left, the next
unevaluated column, after a column is deleted?

For Each rCell In rTtl
strOldHd = rCell.Value

Set rFoundHdr = rOldHds.Find(strOldHd, LookIn:=xlValues,
LookAt:=xlWhole)

If Not rFoundHdr Is Nothing Then
If rFoundHdr.Offset(0, 2).Value = "delete" Then
rCell.EntireColumn.Delete
Set rCell = rCell.Offset(0, -1) <-----OBJECT REQUIRED error

Else
rCell.Value = rFoundHdr.Offset(0, 1).Value
End If
Else
lHdrNotFoundCt = lHdrNotFoundCt + 1
End If
Next rCell

I tried to set it back using an offset, but that doesn't work, I just
get an "Object Required" error on that line.

Thanks for the help.

 

[Dave Peterson]

It's usually easier to start from the far right and work left when you're
deleting columns (or work from the bottom to the top when you're deleting rows).

But you could use something like:

Dim DelRng as range
For Each rCell In rTtl
strOldHd = rCell.Value
Set rFoundHdr = rOldHds.Find(strOldHd, LookIn:=xlValues, LookAt:=xlWhole)
If Not rFoundHdr Is Nothing Then
If rFoundHdr.Offset(0, 2).Value = "delete" Then
if delrng is nothing then
set delrng = rCell
else
set delrng = union(delrng, rCell)
end if
End If
End If
Next rCell

if delrng is nothing then
'nothing to delete
else
delrng.entirecolumn.delete
end if

Untested, uncompiled.

 

[davegb]

Thanks for your reply.

It's usually easier to start from the far right and work left when you're
deleting columns (or work from the bottom to the top when you're deleting rows).

I'd like to know how to do that.

But you could use something like:

Dim DelRng as range
For Each rCell In rTtl
strOldHd = rCell.Value
Set rFoundHdr = rOldHds.Find(strOldHd, LookIn:=xlValues, LookAt:=xlWhole)
If Not rFoundHdr Is Nothing Then
If rFoundHdr.Offset(0, 2).Value = "delete" Then
if delrng is nothing then
set delrng = rCell
else
set delrng = union(delrng, rCell)
end if
End If
End If
Next rCell

if delrng is nothing then
'nothing to delete
else
delrng.entirecolumn.delete
end if

Untested, uncompiled.

I probably didn't make myself clear. There are more than one column to
be deleted. I modified your code to delete each column that was marked
"delete", but it's hanging up.

Sub ChngHeaderRev1()
'Replaces SPSS headers with spreadsheet headers
Dim delrng As Range
Dim rOldHds As Range
Dim rCell As Range
Dim strOldHd As String
Dim strNewHd As String
Dim lEndRow As Long
Dim wbkNewHdr As Workbook
Dim lHdrNotFoundCt As Long
Set wbkNewHdr = Workbooks("PIP Prep Rec.xls")
Set wbkData = ActiveWorkbook
ActiveSheet.Range("A1").Select
Set rTtl = Range(Selection, Selection.End(xlToRight))

lEndRow = wbkNewHdr.Sheets("Macro Records").Cells(Rows.Count, 2) _
.End(xlUp).Row
With wbkNewHdr.Sheets("Macro Records")
Set rOldHds = Range(.Cells(2, 2), .Cells(lEndRow, 2))
End With

lHdrNotFoundCt = 0
For Each rCell In rTtl
strOldHd = rCell.Value

Set rFoundHdr = rOldHds.Find(strOldHd, LookIn:=xlValues,
LookAt:=xlWhole)

If Not rFoundHdr Is Nothing Then
If rFoundHdr.Offset(0, 2).Value = "delete" Then
If delrng Is Nothing Then
Set delrng = rCell
delrng.EntireColumn.Delete
Else
Set delrng = Union(delrng, rCell)
End If
End If

rCell.Value = rFoundHdr.Offset(0, 1).Value <----OBJECT REQUIRED
Else
lHdrNotFoundCt = lHdrNotFoundCt + 1
End If
Next rCell

If lHdrNotFoundCt > 0 Then
If MsgBox(strFName & _
" has " & lHdrNotFoundCt & " unknown headers. Click OK to continue,
Cancel to terminate program.", _
vbOKCancel) <> vbOK Then Exit Sub
End If

End Sub 'ChngHeader

I haven't been able to figure out what's wrong. The same line of code
ran fine in the earlier version, so it must have something to do with
the changes I made. Any ideas?

 

[Dave Peterson]

I didn't look at all your code, but if you noticed, I didn't delete anything
until I was done building that delrng and then I got rid of it all at once.

That way I didn't have to worry about skipping columns that were already gone.

dim iCol as long
for icol = 255 to 1 step -1
if something is true then
delete that column
end if
next icol

is the basic structure if you want to delete column by column.

Maybe to avoid looking at a bunch of unused columns.

with activesheet
For icol = .cells(1,.columns.count).end(xltoleft).column to 1 step -1

'assumes that there's something in row 1.

 

[Dave Peterson]

And you could even start at column 256 if you wanted.

 

[davegb]

I tried putting this into the macro, but I keep getting an "Invalid or
unqualified reference" error on the .columns...

For icol = .cells(1,.columns.count).end(xltoleft).column to 1 step -1

I tried putting in a With statement before this line, thinking maybe it
needed to know which columns, but then I got an "end with without with"
error. I'm missing something here. Any suggestions?