Access VBA, merge a set of cells and then fill it with a value

With objSht.[e1:l1]
  .Merge
  .Value2 = "some text"
  .Interior.Color = vbYellow
End With

Colors can become surprisingly complicated.  For instance you could use  .Interior.colorindex = 6
Let me know if you want to get into those weeds.

See also

• RGB function

If for any reason something slipped from the code above just turn the Developer tab on Excel..record a macro...do what is need to done...end the macro...read the code...job done.

Tried that John, wasn't happy with the results.

rberke, Access did not like that syntax.  I'll keep playing around with it and post the exact error message in the morning.

Dale

Dale, this works nicely for me:

Public Function MergeCells()

    Dim Workbook    As Excel.Workbook
    Dim Worksheet   As Excel.Worksheet
    Dim Range       As Excel.Range
    
    Dim Text        As String
    Dim BackColor   As Long
    
    Set Workbook = ThisWorkbook
    Set Worksheet = Workbook.Worksheets(1)
    Set Range = Worksheet.Range("E1", "L1")
    
    Text = "Some text"
    BackColor = RGB(100, 150, 200)
    
    Range.Merge
    Range.Value = Text
    Range.Interior.Color = BackColor
    
    Set Range = Nothing
    Set Worksheet = Nothing
    Set Workbook = Nothing

End Function

Select allOpen in new window

Here is the code I'm using at the moment:

    Dim oRange as Excel.Range
    Set oRange = oSHT.Range("E1", "L1")
    oRange.Merge
    oRange.Value = "Weekly data"
    oRange.Interior.Color = RGB(255, 255, 204)

Select allOpen in new window

And here is the error:

Run-time error '1004':
Application =-defined or object-defined error

Select allOpen in new window

I don't normally do it this way, I normally do it like:

    oSHT.columns("N").EntireColumn.Autofit
    with osht.Range("E1", "L1")
        .Merge
        .Value = "Weekly data"
        .Interior.Color = RGB(255, 255, 204)
    end with

Select allOpen in new window

But this is generating the same error on the ".Merge" line.  All of the rest of the code that references oSHT is working just fine.

I've learned the hard way always to be very specific about Excel objects.

But it sounds like those cells can't be merged for some reason.

My syntax was correct. I think the author has not initialized objSht correctly.
Try this.  It works on my access 2010.
First open the target excel worksheet then run this code in access.

If it works, I will then help the author figure out what is happening in his code.

Option Compare Database
Option Explicit

     Sub tt()
1000 Dim ap As Object, objsht As Object
     
1010 Set ap = GetObject(, "excel.application")
1020 Set objsht = ap.activesheet
1025 If TypeName(objsht) <> "Worksheet" Then
      MsgBox "objSht is not a Worksheet. It is a " & TypeName(objsht)
   End If

1030 With objsht.[e1:l1]
1040   .Merge
1050   .Value2 = "some text"
1060   .Interior.Color = vbYellow
1070 End With
     
     Exit Sub

err_routine:
MsgBox "error #" & Err & "(" & Error & ") encountered at line " & Erl
Exit Sub

Select allOpen in new window

I can simulate your exact problem by protecting the cells, so try unprotecting them.

    Dim oRange as Excel.Range
    Set oRange = oSHT.Range("E1", "L1")

    osht.unprotect           ' <=== try unprotecting sheet
    oRange.Interior.Color = RGB(255, 255, 204)  ' <== also put color change first to see if that much works
    oRange.Merge
    oRange.Value = "Weekly data"
    

Select allOpen in new window

If that doesn't work, try this code in your Access program.. Line 5 will "kill" all VBA activity..  Immediately switch to Excel and use Alt HMM to manually merge the cells.  I expect the manual merge will still fail which will help you figure things out.

    Dim oRange as Excel.Range
    Set oRange = oSHT.Range("E1", "L1")
   osht.activate
   oRange.select
   end   ' <== this will kill VBA. You can then go to Excel and try merging the cells manually
    oRange.Merge
    oRange.Value = "Weekly data"
    oRange.Interior.Color = RGB(255, 255, 204)

Select allOpen in new window

I don't do "SELECTION" or "ACTIVATE".  Both of those are recipes for failure if the workbook is open and a user inadvertently changes the focus to another worksheet.  Trust me, oSHT is properly declared and assigned.  All of the code in that module which precedes and follows the two .merge commands works just fine.

    dim oSHT as Excel.Worksheet
    dim oRange as Excel.Range
    set oSHT = oWBK.Worksheets(n)
    'Write the column headers to the selected worksheet
    For intcol = 0 To rs.Fields.Count - 1
        oSHT.Cells(2, intcol + 1).Value = Replace(Replace(rs.Fields(intcol).Name, "Wk_", ""), "YTD_", "")
    Next
   
    oSHT.Range("A3").CopyFromRecordset rs
   
    oSHT.Columns("B:D").EntireColumn.AutoFit
    oSHT.Columns("E:M").EntireColumn.ColumnWidth = 6
    oSHT.Columns("N:N").NumberFormat = "0.00%"
    oSHT.Columns("N").EntireColumn.AutoFit
    oSHT.Range("E:N").HorizontalAlignment = xlCenter
    Set oRange = oSHT.Range("E1", "L1")
    With oRange
         .Merge    '<= This line raises the 1004 error
         .Value = "Weekly data"
         .Interior.Color = RGB(255, 255, 204)
    end with
    oSHT.Columns("M:M").EntireColumn.Hidden = True
   
    oSHT.Cells(2, 15).Value = 0
    oSHT.Range("O2").ClearContents
    oSHT.Columns("O").EntireColumn.ColumnWidth = 4
    oSHT.Columns("X").NumberFormat = "0.00%"
    oSHT.Columns("P:W").EntireColumn.ColumnWidth = 7
    oSHT.Columns("X").EntireColumn.AutoFit
    oSHT.Range("P:X").HorizontalAlignment = xlCenter
    Set oRange = oSHT.Range("P1", "X1")
    With oRange 
         .Merge    '<= This line raises the 1004 error
         .Value2 = "Year-to-Date data"
         .Interior.Color = RGB(255, 255, 204)
    End With

Select allOpen in new window

The only lines of code in this entire code segment which fail are the two .Merge lines.

you misunderstood.  My use of select and activate are temporary and only used for trouble shooting.

But if you insist on not using select and activate even temporarily, do the following. It is still temporary code, we will remove it when we figure out what is going wrong.

Put these  lines between line 17 and 18
msgbox oRange.address(,,,true)

orange.parent.unprotect
orange.cells(1).interior.color = rgb(255,255,204)
orange.cells(1) ="weekly data"
orange.merge
end

The above will leave excel open.  Navigate to the address shown by the message box and figure out what is wrong with it

Once you have done the above, save the excel workbook and post it.  I'll bet I can fix it in 5 minutes.  There is no need to post the Access database, I do not need it.

Your code runs fine here. If I protect the worksheet, nearly all code fails - not only the two merges - so you must have done something very special with those cells.

Try another worksheet or rebuild it from scratch.

I got tired of issues like this so, some years ago for a new project, I took the step to build code that creates the worksheets from scratch including everything: Formulas, Named Ranges, tables, formatting, themes, freezing, protection, etc.
This way you can easily perform tests of revisions, revert to a previous version, and your code doubles as documentation for the client and - quite important - for yourself when getting back to your mysterious code after some years.

you must have done something very special with those cells. 

I agree with Gustav; rebuilding your worksheet might solve the problem.  But I still think there must be a much simpler solution.

Please post your "very special" worksheet.  (no need to post the Access code.)
 
I would greatly appreciate seeing the worksheet because I am working on my own version of an Excel Workbook Rebuilder and I need real life examples of weird worksheets to use as test cases.

Thanks a lot.

Rberke (aka UncleBob)




  prefer to find the source of the problem.  I would greatly

At the moment, during testing, I'm creating a new worksheet in a workbook every time I perform this export, so neither the workbook, or worksheet is protected.  I can merge the cells manually.

I'm going to try repairing Office to see if that makes a difference.

This is a very intriguing question and I am looking forward to seeing the final solution.

Am I correct that you have already tried rebooting your machine?
Also, if you have a shared computer network have your tried running the macro on a different computer?

I hope I am wrong, but I predict the office repair will not work.  I also predict sfc /scannow will not help, chkdsk will not help and all the normal troubleshooting tricks will not help.  

But before you go crazy and spend time trying those tricks,  please humor me a bit..  

Please do the following simple troubleshooting. It will take you 5 minutes and it might save your hours of work.

change line 18. Your original code had this at line 18

 .Merge    '<= This line raises the 1004 error

Select allOpen in new window

Temporarily replace line 18 with the following code

on error resume next 
Dim temp As String


    On Error Resume Next
        With Selection
            temp = .address(, , , True)
            .merge
            If err <> 0 Then
               On Error GoTo 0
               MsgBox "please click OK, then save the excel workbook and post it to experts exchange" _
               & vbCrLf & "Sheet name = <" & temp & " >"  _
               & vbCrLf & ActiveCell.address(, , , True)
               
               End
            End If
        
        End With
    On Error GoTo 0 '  <=== use this if you do not already have an error handler
    On Error GoTo your_err_Routine  '  <=== change this if you already have an error handler

Select allOpen in new window

.When your MS Access hits this temporary code, it will display a message then end all vba activity and leave MS Access open.
Please get a screen shot of the message.

Navigate to your Excel workbook and save it.  If necessary obfuscate the contents then post it to  Experts Exchange

Bob

That's an .xlsx file ... so you are running the code from another workbook (*.xlsm)?

Gustav: He is running the code from MS Access.  

Dale: please also post the .xlsx file which I hope you saved immediately after you responded OK to the msgbox screenshot.

I see that you modified my suggested code.  I hope you were not tempted to delete the "end" statement because it was important.  If you did delete the "end" statement, please reinsert it and rerun the test. I need to know that the .xlsx file was unchanged and was saved exactly as it stood at the exact time the msgbox as issued.  

No, G, the code is running from Access, rberke asked for the activecell address, and I threw the range in for good measure.

I'm using oSHT and oRange throughout this module for all sorts of formatting issues, and have not an an issue except for the ".merge" method.

@rberke, not going to be able to get back to this today, other alligators to fight.

Dale

other alligators to fight. 

Take your time.  I am looking forward to a final solution.

I threw the range in for good measure.

 I am very glad you included the ORange address, because that was the most import item.  It thought I asked for oRange but made a stupid mistake in my code.  It should have said this.

 BTW, the .address(,,,True) syntax for these debugging displays is extremely useful because it includes the range's file name and sheet name. It often helps find mistakes when a range variables point to the wrong sheet.

on error resume next
Dim temp As String

    On Error Resume Next
        With oRange  ' <== I had previously posted "With Selection" which was not my intention.
            temp = .address(, , , True)
            .merge
            If err <> 0 Then
               On Error GoTo 0
               MsgBox "please click OK, then save the excel workbook and post it to experts exchange" _
               & vbCrLf & "oSheet full address = <" & temp & " >"  _
               & vbCrLf & ActiveCell.address(, , , True)
               
               End   ' <=== do not remove this line
            End If
       
        End With
    On Error GoTo 0 '  <=== use this if you do not already have an error handler
    On Error GoTo your_err_Routine  '  <=== change this if you already have an error handler

Select allOpen in new window

Congratulations.

But I still don't understand why there was a problem in the first place.  i tried to duplicate your error with the following code, but it works fine on my machine.  There is something else going on.  If you are interested in pursuing this let me know, as I have a few idea.  But I would certainly understand if you wanted to put this problem in the rear view mirror.

Sub t()
   Const xlMinimized = -4140, xlNormal = -4143, xlMaximized = -4137

    Dim wb, oSht, xl
    Set xl = CreateObject("Excel.application")
    xl.Visible = False ' it doesn't seem to matter what I set this to
    Set wb = xl.Workbooks.Add
    Set oSht = wb.Worksheets.Add
    xl.WindowState = xlMinimized ' doesn't seem to matter what I set this to.hhhhhhhhhh
    With oSht.Range("E1", "L1")
       .Merge
    End With
    wb.Close False
    xl.Quit
End Sub 

Select allOpen in new window

@rberke,
Is that code running in an Excel VBA module, or Access.
I've got a solution that works, so I'm not interested in pursuing further.

Thanks for the help.

Is that code running in an Excel VBA module, or Access. 

The code could be run from any Excel workbook or any ms Access database.  You might need to add the following line at the top. (For simplicity I often create an empty workbook or database for testing things.)
    Const xlMinimized = -4140, xlNormal = -4143, xlMaximized = -4137

I've got a solution that works, so I'm not interested in pursuing further. I understand completely, so we can close this question completely.

I understand, so I consider this question to be completely closed.

But, I can't resist one final suggestion.  

I strongly believe WindowState = xlMaximized is a bandaid that covers up a different problem.
If my theory is correct, the .Merge command will usually work perfectly regardless of WindowState.  

So, if you ever have a bit of available time, I hope you can you can follow today's suggestion and report back the results. But, I will completely understand if you decide to let this EE thread come to an end.

TODAY'S SUGGESTION: Prove that xlMaximized is a "bandaid"

FinalTest: Call TemporaryTest(osht)  ' <=== add this line to your current workaround
                          ' then rerun your code. FinalTest should report a problem. 
                          
oXL.WindowState = xlMaximized ' < this is the rest of your unchanged code
with oSHT.Range("E1", "L1")
   .Merge
etc etc etc etc


' Also add the following subroutine to MS Access, then insert it in anywhere your code
Public Sub TemporaryTest(oSht)
    On Error Resume Next
    Debug.Print Time & " Windowstate=" & oXl.windowstate
    oSht.Range("E1", "L1").merge
    If Err <> 0 Then
        MsgBox "oSht merge failed"
    End If
End Sub

Select allOpen in new window

Rerunning your code should now report an error anf FinalTest.

Next  add another call right after whatever line of code that creates the worksheets.
something like this.  

1 YourCurrentCode:     Set oSht = oWb.Worksheets.Add  ' <== your code might be slightly different
2  FirstTest: Call temporaryTest(osht)

Select allOpen in new window

 
I believe that FirstTest: will NOT report a problem and that FinalTest: WILL report the problem.
This will prove that xlMaximized is just a bandaid covering up a different problem.


FUTURE SUGGESTION:
The above code suggestions were easy and safe.

To uncover the "different problem" simply scatter TemporaryTest along the code path until you find which lines of code introduce the problem

Yep, I am finally done. But if you decide to do further research I hope to hear from you.

UncleBob