Multiple Worksheet_Change commands on the same work sheet

[CAMARD2]

I have 2 worksheet_change commands on the same worksheet right now which is not working. I’m assuming I need to combine them into one but I’m having trouble doing so on my own.

Here is my current code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target AsRange)
If Not Intersect(Target, Range("E81, E82,E83, E84, E85, E86, E87, E88, E89, E90")) Is Nothing Then
FixMerge
End If
End Sub

Private Sub Worksheet_Change(ByVal Target AsRange)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target,Range("C3,C31,C40,C44,C54,A63")) Is Nothing Then
If Target.Value = "" Then
Cells(Target.Row,"I").Value = ""
Else
Range("I" &Target.Row).Value = Application.UserName
End If
End If
EndSub

If someone could help me set this up properly I would appreciate it!

Also another side question, as you can see in the first part of the code I’ve got a range from E81 to E90, but this is just a small section, I cut out the rest but I need the range to go from E81 to E220. I tried with E81:E220 but to no avail. I also have a module opened for this where I would also need to modify the range. Here is the section in question:

'CellRanges below, change to suit.
ar= Array("E81", "E82", "E83", "E84","E85", "E86", "E87", "E88","E89", "E90")
For i = 1 To UBound(ar)

(Sorry, was not able to properly put this one in code text for some reason)
How could I word that to have it range from E81 to E90 ?

Thank you

 

[steve the fish]

Try this. You will have to be a bit more explicit about the side question as im not sure what you mean.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("E81:E220")) Is Nothing Then
    FixMerge
ElseIf Not Intersect(Target, Range("C3,C31,C40,C44,C54,A63")) Is Nothing Then
    If Target.Value = "" Then
        Cells(Target.Row, "I").Value = ""
    Else
        Range("I" & Target.Row).Value = Application.UserName
    End If
End If

End Sub

 

[CAMARD2]

Thanks!

For the other question, I have some code in a module that is directly related to the code above.

Here is the code in its entirety:

Option Explicit
Option Base 1
Sub FixMerge()
Dim mw As Single
Dim cM As Range
Dim rng As Range
Dim cw As Double
Dim rwht As Double
Dim ar As Variant
Dim i As Integer
Application.ScreenUpdating = False
'Cell Ranges below, change to suit.
ar = Array("E81", "E82", "E83")
For i = 1 To UBound(ar)
    On Error Resume Next
    Set rng = Range(Range(ar(i)).MergeArea.Address)
    With rng
      .MergeCells = False
      cw = .Cells(1).ColumnWidth
      mw = 0
      For Each cM In rng
          cM.WrapText = True
          mw = cM.ColumnWidth + mw
      Next
      mw = mw + rng.Cells.Count * 0.66
      .Cells(1).ColumnWidth = mw
      .EntireRow.AutoFit
      rwht = .RowHeight
      .Cells(1).ColumnWidth = cw
      .MergeCells = True
      .RowHeight = rwht
    End With
Next i
    Application.ScreenUpdating = True
End Sub

The part in which I bolded (the range) does not work if I simply type "E81:E220"

 

[steve the fish]

If you want to put E81:E200 into an array you cant just use:

arr=Range("E81:E200")

 

[CAMARD2]

That isn't giving me an error code but it is not working.

 

[steve the fish]

What does not working mean?

 

[CAMARD2]

The code is supposed to automatically adjust the height of some merged cells. When I type out each cell individually it works fine, but if I type it as "E81:E220" it no longer adjusts the height automatically

 

[steve the fish]

Oh you want the address of the cell in the array? Heres how you could do that:

Dim ar(1 To 120)

For i = 1 To UBound(ar)
    ar(i) = Range("E" & i + 80).Address
Next

 

[steve the fish]

The way you would normally loop through cells is like this though:

For Each c In Range("E81:E200")
    Set rng = c.MergeArea
    'etc
Next

 

[CAMARD2]

Oh, I created a separate thread for this as I have not yet received an answer that solves my problem, and this thread was more about another issue I was having (hence the title), but my apologies! I'll just paste what I wrote in my new thread here:

Hey,

I need help with creating an array from a range of cells

I currently have this code in place:

Option Explicit
Option Base 1
Sub FixMerge()
Dim mw As Single
Dim cM As Range
Dim rng As Range
Dim cw As Double
Dim rwht As Double
Dim ar As Variant
Dim i As Integer
Application.ScreenUpdating = False
ar = Array("E80", "E81", "E82", "E83", "E84", "E85", "E86", "E87", "E88", "E89", "E90")
For i = 1 To UBound(ar)
On Error Resume Next
Set rng = Range(Range(ar(i)).MergeArea.Address)
With rng
.MergeCells = False
cw = .Cells(1).ColumnWidth
mw = 0
For Each cM In rng
cM.WrapText = True
mw = cM.ColumnWidth + mw
Next
mw = mw + rng.Cells.Count * 0.66
.Cells(1).ColumnWidth = mw
.EntireRow.AutoFit
rwht = .RowHeight
.Cells(1).ColumnWidth = cw
.MergeCells = True
.RowHeight = rwht
End With
Next i
Application.ScreenUpdating = True
End Sub

(not allowing me to put this in code, sorry)
As you can see, I individually listed each cell between E80 to E90. The code is working fine as is but I need to make the range much longer (E80:E220) however I’m having trouble properly inserting the range into the array. I tried:

Dim myArr As Variant
myArr = Range(“E80:E220”)

I’ve search all over the internet and apparently that should be working, but it is not. Can somebody here please help me properly set this up? It's probably something so stupid that I am missing, but I'm new to this stuff and just can't seem to figure it out...

Thank you