Shifting Dynamic Columns to the Right VBA (Object req'd error) - excel

Question

I am trying to select columns based on their heading value and then move them over to the end on the right. I know it is selecting the columns correctly, and identifying the next empty column. However, when running the code, it'll get down to the emptyRange.select.offset and then gives an error saying an object is required.
I'm not sure if I am overcomplicating this code.
Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim emptyRange As Range
With Sheets("Data")
Set dCol = Range( _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
Set qCol = Range( _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
End With
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
Exit For
End If
Next cell
dCol.Select
Selection.Cut
emptyRange.Select.Offset
Selection.Insert Shift:=xlToRight
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
Exit For
End If
Next cell
qCol.Select
Selection.Cut
emptyRange.Select
Selection.Insert Shift:=xlToRight
End Sub
Sloppy solution below
Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim emptyRange As Range
Dim MyRange As Range
Dim iCounter As Long
With Sheets("Data")
Set dCol = Range( _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
Set qCol = Range( _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
End With
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
col = ActiveCell.Column
Exit For
End If
Next cell
dCol.Select
Selection.Cut
Cells(1, col).Select
ActiveSheet.Paste
'Blank Column Deleter
Set MyRange = ActiveSheet.UsedRange
For iCounter = MyRange.Columns.Count To 1 Step -1
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
Next iCounter
'
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
col = ActiveCell.Column
Exit For
End If
Next cell
qCol.Select
Selection.Cut
Cells(1, col).Select
ActiveSheet.Paste
'Blank Column Deleter
Set MyRange = ActiveSheet.UsedRange
For iCounter = MyRange.Columns.Count To 1 Step -1
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
Next iCounter
End Sub

Answer 1

Couple of problems I see.
1) You are not checking if emptyRange is allocated with an object reference before trying to access it. Now, your worksheet might never have a data width that exceeds column "ZZ", but that is not good practice. That could be your problem, but it might not be - I wouldn't be able to tell without seeing your data.
2) I don't see what you are trying to do there with Offset. You haven't specified an argument for rows up/down or columns left/right so it's really not doing anything. Also, I don't think you can use it after a select statement like that. If you wanted to do that you would do:
emptyRange.Select
Selection.Offset(0,1) `this would offset one column - not sure what you wanted to do
But that whole selection step is unnecessary as you can work with the object directly:
emptyRange.Offset(0,1)
As to whether or not you're overcomplicating things: yes - you can simplify this code quite a bit by getting rid of all the Activate & Select methods and just working with the objects directly.
Instead of looping over all the cells in A1:ZZ1, just use the Find method again. The other benefit of this, is that using find as I've done below will always return an object (in excel 2007 and up) so you won't need a check like I mentioned above.
I don't particularly like the use of two find statements to create a range of used data for dCol and qCol - I found it difficult to read and interpret what you were doing. Here again I wouldn't use a fixed sized range as I mentioned above - this makes your code more fragile. I actually think it's a lot easier to read and understand if you break this into two operations: 1) find the column, 2) resize the range down to the last row in the column
You can avoid a second loop by using Offset to just move over one column, and you can eliminate the insert line by providing the destination argument for cut.
EDIT after OP posted "sloppy solution":
You can greatly simplify the code by just selecting the entire column and inserting it before the last empty column. You then don't need any routine to cleanup blank columns.
Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim destination As Range
With Sheets("Data").Cells
'Find the cell in row 1 which contains "name_a"
Set dCol = .Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False).EntireColumn
'Repeat same steps for qCol
Set qCol = .Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False).EntireColumn
'Find the last column which has data in it, and get the next column over (the first empty column)
Set destination = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious).Offset(0, 1).EntireColumn
End With
'Insert dCol before the first empty column at the end of the data range:
dCol.Cut
destination.Insert shift:=xlShiftToRight
'Insert qCol before that same empty column
qCol.Cut
destination.Insert shift:=xlShiftToRight
End Sub