So simple I'm ashamed to post

[austenr]

The following code is intended to check row by row for the conditions. If you run the first If statement alone it works, however, if you run the entire module it does nothing. This is probably really easy but I can't see it.



Sub FixReport()
'Executes the fix
Application.ScreenUpdating = False
If Sheet1.Range("A1") = "" Then
Range("B:F").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Sheet1.Range("B1") = "" Then
Range("C:G").Select
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Sheet1.Range("C1") = "" Then
Range("D:H").Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Sheet1.Range("D1") = "" Then
Range("E:I").Select
Selection.Cut
Range("D1").Select
Active.Sheet.Paste
Application.CutCopyMode = False
Else
If Sheet1.Range("E1") = "" Then
Range("F:J").Copy
Selection.Cut
Range("E1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
End If
End If
End If
End If
End If
End Sub

[TonyJollans]

Probably a silly question but where is the code - (a) when you run the first if alone? and (b) when you run the whole thing? Your Range references are all a bit different - are you sure that they all refer to the sheets you want them to?

[austenr]

Sorry I was not clear, I meant if you comment out everything but the first If it works, however if you do not comment out anytthing, it doesn't work. All the references refer to Sheet1. Thanks

[johnske]

Hi Austen,

Try replacing the "Elses" with "End If" and remove all the "End Ifs" from the bottom (assuming you want the copying done for all instances where sheet1 is empty)
Plus, as Tony says, the range references all seem strange, they appear to be pasting one thing over something else that's just been pasted?

[TonyJollans]

What do you mean by "works"? If there is nothing in A1 it moves columns B:F into columns A:E and if there is something in A1 it does nothing. Does it do both of these things? And if you simply uncomment the rest of the code it then doesn't do one or both of these things? And you don't change the active sheet?

All of your ranges do not refer to Sheet1. Which is why I asked if you were sure they referred to what you wanted.

[geekgirlau]

Assuming that you definitely want to cut and paste the entire column based on the data in the first row, try the following:



Sub FixReport()
' Executes the fix
Application.ScreenUpdating = False
Sheet1.Range("A1").Select
' locate the first blank cell in row 1
Do Until ActiveCell.Formula = ""
ActiveCell.Offset(0, 1).Select
Loop
' only check the first 5 columns
If ActiveCell.Column > 5 Then
Exit Sub
Else
' cut the next 5 columns
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.Offset(0, 4)).Select
Selection.EntireColumn.Cut
' paste over the blank column
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
End Sub

[HalfAce]

Hello,
First off I must say your original code worked as is for me (?)
However you don't usually need to select ranges to work with them and your code is more efficient and quicker if you don't.

Here are a few examples of what I mean. #1 is how I would write your original code:


Sub FixReport()
'Executes the fix
Application.ScreenUpdating = False
If Sheet1.[A1] = "" Then
[B:F].Cut [A1]
ElseIf Sheet1.[B1] = "" Then
[C:G].Cut [B1]
ElseIf Sheet1.[C1] = "" Then
[D:H].Cut [C1]
ElseIf Sheet1.[D1] = "" Then
[E:I].Cut [D1]
ElseIf Sheet1.[E1] = "" Then
[F:J].Cut [E1]
End If
Application.ScreenUpdating = True
End Sub

Example #2 is another way, incorporating a little bit of geekgirlau's idea.


Sub FixReport()
Dim x As String
x = ActiveSheet.Name
Application.ScreenUpdating = False
If Sheet1.[A1] = "" Then
[B:F].Cut [A1]
Application.ScreenUpdating = True
Exit Sub
End If
Sheet1.Select
[A1].Select
While ActiveCell <> ""
ActiveCell(1, 2).Select
Wend
If ActiveCell.Column > 5 Then Exit Sub
Select Case ActiveCell.Address
Case "$B$1"
Sheets(x).[C:G].Cut Sheets(x).[B1]
Case "$C$1"
Sheets(x).[D:H].Cut Sheets(x).[C1]
Case "$D$1"
Sheets(x).[E:I].Cut Sheets(x).[D1]
Case "$E$1"
Sheets(x).[F:J].Cut Sheets(x).[E1]
End Select
Sheets(x).Select
Application.ScreenUpdating = True
End Sub

You may want to give one of these a shot, but then who knows what result you'll get. Like I said, I had no problem with your original code...

Hope it helps,
Dan

[Ken Wright]

If I've guessed your objective correctly:-



Sub FixReport()
ActiveSheet.Range("A1", Range("A1").End(xlToRight).Offset(0, -1)).EntireColumn.Delete
End Sub

[johnske]

Hi Austen,

I've been away for a few days and I see you have a solution now. However here's a completely different approach for any future similar problems. (It's also faster cos there's no need for data to go into memory for a cut n paste)

If I understand the problem correctly - if the cell in the first row of any one of the 1st 5 columns is empty, then you want to select the next 5 columns to the right of this cell & cut n paste them 1 column to the left.

Instead of cutting and pasting all the data in 5 entire columns i would be inclined to simply delete the offending empty column (thereby moving the next 5 columns 1 column to the left anyway). This'll do that >>


Sub ReportFix()
Dim N%
Application.ScreenUpdating = False
For N = 1 To 5
If Sheet1.Columns(N).Rows(1) = Empty Then
Columns(N).EntireColumn.Delete
Exit Sub
End If
Next N
End Sub

However it's possible you may have further data to the right of this again and you need this data to be in a certain column - in that case, insert a new empty column to the right >>


Sub ReportFix()
Dim N%
Application.ScreenUpdating = False
For N = 1 To 5
If Sheet1.Columns(N).Rows(1) = Empty Then
Columns(N).EntireColumn.Delete
Columns(N + 5).Select
Selection.Insert Shift:=xlToRight
Exit Sub
End If
Next N
End Sub


Now, only you know exactly what's required to be done, but it would seem to me that your procedure is incomplete...what about the case where (say) both A1 and B1 or B1 and D1 are empty? Wouldn't you have to run the macro again? If that IS the case, just remove the "Exit Sub" from either of the above procedures to remove all columns with an empty cell in the 1st row.

Regards,
John

[Ken Wright]

Oops - should have catered for no blanks


Sub FixReport()
With Sheets("Sheet1")
If .Range("A1").Value = "" Then
.Range("A1", Range("A1").End(xlToRight).Offset(0, -1)).EntireColumn.Delete
End If
End With
End Sub