VBA - For Each...Next Statement not moving 1 column

[spidaman]

In the following code I am trying to use the For Each...Next statement to identify cells in a range that contain a particular string. Then I want to cut each entire column and move to Columns(1). There are usually at least 3 or 4 of these columns. At the moment the code is moving all columns where the header contains this string apart from one that it leaves behind.

I am struggling to correct this so that all columns with the string in the header are moved. Please can anyone identify the problem and correct for me?

Dim lcol As Long
Dim AttStr As String

lcol = Range("A1").End(xlToRight).Column
AttStr = "Attachment"


For Each Mycel7 In Range(("G1"), Cells(lcol))
        If InStr(Mycel7.Value, AttStr) > 0 Then
            Mycel7.EntireColumn.ColumnWidth = 18
            Mycel7.EntireColumn.Cut
            Range("A:A").Insert Shift:=xlToRight
        End If
Next Mycel7

 

[joeu2004]

I think you want to write:

For Each Mycel7 In Range("G1").Resize(1, lcol)

Note that lcol contains the column number of the rightmost cell in row 1 (contiguous with A1).

When you write Cells(lcol), you are using lcol as a row number.

I presume that you want the lcol number of cells in row 1 starting with G1. So, if lcol is 5, I think you want the range G1:K1.

That said, I have not looked at the rest of your code to see if it does what you intend, even with that correction.

 

[Marcelo Branco]

Try this

For Each Mycel7 In Range("G1", Cells(1, lcol))
        If InStr(1, Mycel7.Value, AttStr, vbTextCompare) > 0 Then

M.

 

[deadlyduck]

This seems to work but I'm sure could be improved:

Dim lcol As Long
Dim AttStr As String

lcol = Cells(1, Columns.Count).End(xlToLeft).Column
AttStr = "Attachment"

For Each Mycel7 In Range(("G1"), Cells(lcol))
        
        If InStr(Mycel7.Value, AttStr) > 0 Then
            
            currcol = Mycel7.Column
            Columns(currcol).EntireColumn.ColumnWidth = 18
            Columns(currcol).EntireColumn.Cut
            Range("A:A").Insert Shift:=xlToRight
            currcol = currcol + 1
            
        End If

Next Mycel7

 

[spidaman]

Unfortunately none of the above adjustments have it working yet.

In my current data there are 3 columns where AttStr appears in the column header. At the moment the middle column is the one that is being left behind in case this helps.

I understand that the Range

[COLOR=#333333]Range(("G1"), Cells(lcol)) [/COLOR]

will change as the columns are cut and moved into Column 1. Is this what is causing the problem?

Originally I was trying to use an adjusted Range where TargetStr18 was a column that I had moved earlier. But this wasn't working either:

TargetStr18 = "Comments"


Set movecell4 = titRng.Find(what:=TargetStr18, LookIn:=xlValues, _
lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=True, SearchFormat:=False)

AttStr = "Attachment"
lcol = Range("A1").End(xlToRight).Column


    For Each Mycel7 In Range((movecell4), Cells(lcol))
       
        If InStr(Mycel7.Value, AttStr) > 0 Then
            Mycel7.EntireColumn.ColumnWidth = 18
            Mycel7.EntireColumn.Cut
            Range("A:A").Insert Shift:=xlToRight
        End If


    Next Mycel7

 

[deadlyduck]

Could you consider posting a desensitized copy of your workbook with a 'BEFORE worksheet' and 'AFTER worksheet' version of what you're looking for.

I thought my own macro seemed to work but maybe as you say it's something to do with the range moving as columns are shifted right. Note also that my lcol variable is determined using a slightly a different method to the code you posted.

 

[spidaman]

Could you consider posting a desensitized copy of your workbook with a 'BEFORE worksheet' and 'AFTER worksheet' version of what you're looking for.

I thought my own macro seemed to work but maybe as you say it's something to do with the range moving as columns are shifted right. Note also that my lcol variable is determined using a slightly a different method to the code you posted.

Ok thanks, I'll post a sanitised extract tomorrow morning. I don't think the lcol variable is a problem tbh. Think its the changing range. Was thinking to try Find....Next instead of For Each as another option....?

 

[spidaman]

Thanks for your help with this one, but I managed to move the columns using Find...Next method with a loop instead. It may have been the shifting range that was causing the problem as , although I'm not sure to be honest.

This code worked though:

Dim TargetStr18 As String
Dim NewRng As Range, movecell14 As Range

TargetStr18 = "Attachment*"


Set NewRng = Range("G1:CZ1")


Set movecell14 = NewRng.Find(What:=TargetStr18, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=True, SearchFormat:=False)


If Not movecell14 Is Nothing Then


Do Until movecell14 Is Nothing


            movecell14.EntireColumn.ColumnWidth = 10
            movecell14.EntireColumn.Cut
            Range("A:A").Insert Shift:=xlToRight


            Set movecell14 = NewRng.FindNext


        Loop


Else


End If