Are watermarks considered a merged cell?

[philwojo]

Hello, I am helping my wife with a spreadsheet she is using for work and it was up and working fine, thanks to help I had received previously. But now she and one of her coworkers were asked to add a watermark to the sheet on each tab. Now when the script is called it stops and give the following errors:

Run-time error '1004':
cannot change part of a merged cell.

I searched for merged cells in the document and as far as the script is concerned there are none, other than maybe this new watermark.

So, does VBA or scripting think that a watermark is a merged cell?

Is there any kind of a workaround if it does think of it as being merged?

Here is the current script we are using:

Sub CopyFmMaster()
'Developed by ASidman 1/27/2014

Set Rng = ActiveCell
Application.ScreenUpdating = False
Application.Run ("Unprotect_all_sheets")

'Delete all information in Range B3:K-last row
    Dim w As Worksheet
    For Each w In Worksheets
    Dim lrx As Long
    lrx = w.Range("B" & Rows.Count).End(xlUp).Row
    If w.Name <> "Master - INPUT ONLY" And w.Name <> "Sheet3" Then
    w.Range("B3:K" & lrx).Clear
    End If
    Next w

'Copy data from Input Sheet to detailed sheets
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim w3 As Worksheet
    Dim w4 As Worksheet
    Dim w5 As Worksheet
    Dim w6 As Worksheet
    Set w1 = Sheets("Master - INPUT ONLY")
    Set w2 = Sheets("Closed to New Investors")
    Set w3 = Sheets("Liquidation")
    Set w4 = Sheets("Merger")
    Set w5 = Sheets("Name Change")
    Set w6 = Sheets("New Product Launch")
    Dim i As Long
    Dim lr1 As Long
    lr1 = w1.Range("A" & Rows.Count).End(xlUp).Row
    Dim lr2 As Long
    Dim lr3 As Long
    Dim lr4 As Long
    Dim lr5 As Long
    Dim lr6 As Long
    
    For i = 3 To lr1
        lr2 = w2.Range("B" & Rows.Count).End(xlUp).Row
        lr3 = w3.Range("B" & Rows.Count).End(xlUp).Row
        lr4 = w4.Range("B" & Rows.Count).End(xlUp).Row
        lr5 = w5.Range("B" & Rows.Count).End(xlUp).Row
        lr6 = w6.Range("B" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = False
    If w1.Range("D" & i) = "Closed to New Investors" Then
        w1.Range("B" & i & ":K" & i).Copy w2.Range("B" & lr2 + 1)
    ElseIf w1.Range("D" & i) = "Liquidation" Then
        w1.Range("B" & i & ":K" & i).Copy w3.Range("B" & lr3 + 1)
    ElseIf w1.Range("D" & i) = "Merger" Then
        w1.Range("B" & i & ":K" & i).Copy w4.Range("B" & lr4 + 1)
    ElseIf w1.Range("D" & i) = "Name Change" Then
        w1.Range("B" & i & ":K" & i).Copy w5.Range("B" & lr5 + 1)
    ElseIf w1.Range("D" & i) = "New Product Launch" Then
        w1.Range("B" & i & ":K" & i).Copy w6.Range("B" & lr6 + 1)
    End If
    Next i
    Application.CutCopyMode = False
    
 'Sort Data in each sheet by the data in Ascending order.
        For Each w In Worksheets
        If w.Name <> "Master - INPUT ONLY" And w.Name <> "Sheet3" Then
        lrx = w.Range("B" & Rows.Count).End(xlUp).Row
        Range("B2:K" & lrx).Sort Key1:=Columns("E"), Order1:=xlDescending, Header:=xlYes, DataOption1:=x1SortNormal
        End If
    Next w
    
    Application.Run ("Sort_Newest_to_Oldest")
    Application.Run ("Protect_all_sheets")
    Application.ScreenUpdating = True
    Application.Goto Rng
    MsgBox ("Update Completed")

End Sub

Thanks for any help.
Phil

 

[RoryA]

It would suggest that the merged cells are on the 6th sheet that isn't called "Master - INPUT ONLY" or "Sheet3".

 

[philwojo]

Yea that is what I was thinking and I don't see any merged cells on that sheet, other than the header column which is column-a, which should be ignored by the script as it should only try and clear items from B3-K, at least that is how it worked before and how I think the script it written, but i could be wrong on that.

Any other thought being there is no merged cells in the B3:K ranger on any sheet?

 

[philwojo]

I miscounted, it was on the 5th time through that loop, not the 6th, but regardless neither of those sheets has merged cells in anything but "A".

Here is the code I ran to double check for merged cells:

Sub FindMerged4()
Dim c As Range
Dim sMsg As String
sMsg = ""
For Each c In ActiveSheet.UsedRange
If c.MergeCells Then
If sMsg = "" Then
sMsg = "Merged worksheet cells:" & vbCr
End If
sMsg = sMsg & Replace(c.Address, "$", "") & vbCr
End If
Next
If sMsg = "" Then
sMsg = "No merged worksheet cells."
End If
MsgBox sMsg
End Sub

When I run that it lists the merged cells on the active sheet as being A1, B1,..., K1, it doesn't list anything else.

So, again, as I read it, being my loop is only trying to clear B3:K it shouldn't cause this issue.

I think I am missing something, but I can't figure it out.

 

[RoryA]

Is there any data in column B on that sheet? Where are the merged cells on that sheet exactly?

 

[philwojo]

Currently there is no data in column-b on that sheet.

I was also mis-speaking earlier, the merged data is in Row-1, across columns a-k, sorry I get my terms mixed up sometimes, I apologize as I know it makes it harder to assist me.

On that sheet, currently, there is nothing in B3-Kxx, all cells are blank.

The merged cells on all sheets are A1-K1, that is all, nothing else is merged.

 

[RoryA]

That's the problem then. If there's no data in column B, this line:

lrx = w.Range("B" & Rows.Count).End(xlUp).Row

will return 1, so you're trying to clear the merged header row. You need to add a test like:

if lrx > 2 then w.Range("B3:K" & lrx).Clear

 

[philwojo]

OK, I am a little confused, I think I follow what you are saying, but other sheets in the same workbook look exactly like the one it is faulting on and they appear to step through them fine. So why is it having an issue with just this one sheet?

And do I put your new code in place of my existing line, or add it as a separate line of code?

Thanks, again, sorry new to this so just trying to get my head around what you are saying.

 

[RoryA]

Just change this:

w.Range("B3:K" & lrx).Clear

to the version I posted.

 

[philwojo]

OK I see what you were doing/saying now, lrx is coming back with a value of 1, so it is trying to clear the A1-K1 cells, which are merged, so it is faulting out. I get that part now.

But why is it doing that only for one sheet?

I also figured out to add your code down lower, at this part, or at least this is where I think you meant for me to put it:

You meant to replace this line:

   w.Range("B3:K" & lrx).Clear

With this:

if lrx > 2 then w.Range("B3:K" & lrx).Clear

Or at least I think that is what you mean, correct?

Phil

 

[philwojo]

Ha, you beat me to it, while I was posting the same thing.

It appears to be working, thanks so much, and I think I understand, at least partially, why it was faulting out now.

I will have them test it and post back.

Phil