1
\$\begingroup\$

This code merges cells in multiple columns on multiple sheets, and it's too slow.

I'm hoping for any help at all to speed this up. Unfortunately, I'm not able to get around the fact that the cells must be merged.

I broke up the for statements - it helped a bit, but it's still very, very slow.

Also, I turned off screenupdating, events, calculation, displaypagesbreaks, etc.; it didn't seem to help.

Function MergeCells()
 Dim WS_Count As Integer
 Dim i As Integer
 Dim ShName As String
 WS_Count = ActiveWorkbook.Worksheets.Count
 PIS.Activate
 For i = 1 To WS_Count
 Select Case ActiveWorkbook.Worksheets(i).Name
 Case "Med Curr", "Med Ren", "Med RevRen", "Med Prop", "Med Renewal Alts A", "Med Renewal Alts B", _
 "Med Renewal Alts C", "Med Prop Other Markets 1A", "Med Prop Other Markets 1B", "Med Prop Other Markets 1C", _
 "Med Prop Other Markets 2A", "Med Prop Other Markets 2B", "Med Prop Other Markets 2C", _
 "Med Prop Other Markets 3A", "Med Prop Other Markets 3B", "Med Prop Other Markets 3C"
 ActiveWorkbook.Worksheets(i).Activate
 ShName = ActiveSheet.Name
 MergeCellsx (ShName)
 End Select
 Next i
End Function
Function MergeCellsx(ShName)
 Dim RngB As Range
 Dim row As Integer
 With Sheets(ShName)
 For row = 6 To 12
 Set RngB = .Range(.Cells(row, 2), .Cells(row, 3))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 5), .Cells(row, 6))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 8), .Cells(row, 9))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Next row
 For row = 14 To 18
 Set RngB = .Range(.Cells(row, 2), .Cells(row, 3))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 5), .Cells(row, 6))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 8), .Cells(row, 9))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Next row
 For row = 20 To 22
 Set RngB = .Range(.Cells(row, 2), .Cells(row, 3))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 5), .Cells(row, 6))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 8), .Cells(row, 9))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Next row
 For row = 24 To 25
 Set RngB = .Range(.Cells(row, 2), .Cells(row, 3))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 5), .Cells(row, 6))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 8), .Cells(row, 9))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Next row
 For row = 27 To 34
 Set RngB = .Range(.Cells(row, 2), .Cells(row, 3))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 5), .Cells(row, 6))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Set RngB = .Range(.Cells(row, 8), .Cells(row, 9))
 RngB.Merge
 RngB.HorizontalAlignment = xlCenter
 Next row
 End With
End Function
Jamal
35.2k13 gold badges134 silver badges238 bronze badges
asked Apr 25, 2017 at 19:32
\$\endgroup\$
8
  • 1
    \$\begingroup\$ You should summarize what your code is supposed to do in your question title. Also give some more background in your question body. You might be interested to read How do I ask a good question. \$\endgroup\$ Commented Apr 25, 2017 at 19:36
  • \$\begingroup\$ This might help you with the not able to get around the fact that the cells must be merged part. \$\endgroup\$ Commented Apr 25, 2017 at 20:33
  • \$\begingroup\$ You've a lot of copied info Set RngB = .Range(.Cells(row, 2), .Cells(row, 3)) that could become a its own Sub MergeAndCenter(ByVal ws as worksheet, ByVal rw as Long, ByVal cl as Long). It would at least make future edits easier and your code quite a bit neater. \$\endgroup\$ Commented Apr 25, 2017 at 20:49
  • \$\begingroup\$ I have to ask... how about formatting as Center Across Selection? \$\endgroup\$ Commented Apr 25, 2017 at 21:03
  • \$\begingroup\$ @PeterT asks a good question - center across selection is pretty much always preferable to merging. \$\endgroup\$ Commented Apr 26, 2017 at 18:46

1 Answer 1

1
\$\begingroup\$

Some notes -

Sub or Function

Functions should be used when something is returned and subs should be used when something happens. In this case they are actually both Subs.


Naming

So I think PIS is the actual name of the sheet, not a variable. But, it's all uppercase and not very descriptive. In this case I would think it's a constant because Standard VBA naming conventions have camelCase for local variables, UPPER_CASE for constants and PascalCase for other variables and names.


Variables

You did a good job declaring all of your variables, but it's always a good idea to turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

Names - names are cheap and characters are free. You can use this to your advantage by giving all of your variables descriptive names. For instance - RngB tells me nothing about what that range is supposed to be doing.

Integers - integers are obsolete. According to msdn VBA silently converts all integers to long.


Select Case

Why do you have a select case given you're basically using it like an IF? It looks pretty messy, to me. You could fix that up with a constant. Personally, I'd pull it out as its own function -

Private Function IsTargetSheet(ByVal sheetName As String) As Boolean
 Const SHEET_NAMES As String = "Med Curr, Med Ren, Med RevRen, Med Prop, Med Renewal Alts A, Med Renewal Alts B, Med Renewal Alts C, Med Prop Other Markets 1A, Med Prop Other Markets 1B, Med Prop Other Markets 1C, Med Prop Other Markets 2A, Med Prop Other Markets 2B, Med Prop Other Markets 2C, Med Prop Other Markets A, Med Prop Other Markets 3B, Med Prop Other Markets 3C"
 If InStr(1, SHEET_NAMES, sheetName) > 0 Then
 IsTargetSheet = True
 Else: IsTargetSheet = False
End Function

And now you just need this in the main sub -

For i = 1 To sheetCount
 sheetName = ActiveWorkbook.Sheets(i).Name
 If IsTargetSheet(sheetName) Then MergeCellsx sheetName
Next i

MergeCellsx

In case you didn't know, a Sub can take an argument the same way as a function -

Sub MergeCells(ByVal sheetName as String)

I see you are targeting columns 2 and 3, 5 and 6, 8 and 9. When you have something like that, it might be better to put those number in a variable or constant so that if they change, you can just change the initial value of the variable. -

Const FIRST_NAME_COLUMN As Long = 2
Const SECOND_NAME_COLUMN As Long = 3

Now every time you type in the columns, you can use the constant which will tell you what the column is supposed to contain.

Also, in this instance, you would probably be better with a long if instead of 15 conditional loops. Maybe even the select case would belong here. When you see repeated code like that, it's an indication you can refactor it.

answered Apr 27, 2017 at 18:30
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.