How to Offset to get past merged cells ?

F

Fred

I have a spreadsheet with a variety of cells, some of which are merged
(across variable number of columns) and in varying columns across the
worksheet. there are some constants, in that the first column of each
group does not contain merged cells (contains the Project Name in row
3), the next column may or may not contain merged cells, but the
common point in each set is in Row 20 in the column following the
Project Name column. I need to move 1 set of columns past this column
before I do my insert of the template columns.

How do I code the Offset to ignore the Merged (or not) columns ?

Sub AddTeam()
'
' AddTeam Macro
' Macro to add a new team to an existing project
'
whereami_Row = ActiveCell.Row
whereami_Col = ActiveCell.Column
whereislast_Col = ActiveSheet.Cells.Find(what:="*",
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

If whereislast_Col < whereami_Col Then
MsgBox ("Cursor not within a project" & vbCrLf & _
"Select a cell within the project and try again")
Exit Sub
End If

If whereami_Col < 17 Then
MsgBox ("Cursor not within a project" & vbCrLf & _
"Select a cell within the project and try again")
Exit Sub
End If
Application.EnableEvents = False
Project_Name = 0
'*
'*** Loop until we get back to the project name column
'*
Do Until Project_Name = 1
If Not ActiveSheet.Cells(3, whereami_Col).Value = "" Then
Row3Value = ActiveSheet.Cells(3, whereami_Col).Value
Select Case Row3Value
Case "A", "C", "D", "G", "H", "N", "P", "R", "S", "T",
"X"
whereami_Col = whereami_Col - 1
Case "Status"
whereami_Col = whereami_Col - 1
Case Else
Project_Name = 1 ' found it
End Select
Else
whereami_Col = whereami_Col - 1
End If
Loop
ActiveSheet.Cells(20, whereami_Col).Select
'*
'*** Need to move across by 2 sets of columns,
'*** whether they are 3 merged columns or a single column
'*
whereami = ActiveCell.Address
Range(whereami).Offset(0, 2).Select ' always goes to the next
column
whereami = ActiveCell.Address
'*
'*** Copy and insert template columns
'*
Application.ScreenUpdating = False
Columns("A:B").Select
Selection.EntireColumn.Hidden = False
Selection.Copy
Columns(whereami_Col).Insert
Columns("A:B").Select
Selection.EntireColumn.Hidden = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Thanks in advance for any help

Regards
Fred
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top