Error 424 ruinning my day (again)

Bonbi456

New Member
Joined
Feb 8, 2023
Messages
14
Office Version
  1. 365
Platform
  1. Windows
Hi people, I've written a code (alot of help from here, thanks fellas and lasses) that does many things. Essentially it loops through each worksheets starting with MW, in these sheets, it deletes some columns, does some operations and changes some column names. Right now, The code works, but after adding the loop through worksheets, I get an error 424 on the "If not Rng Is Nothing Then Rng.EntireColumn.Delete"

How can I fix this?

Here's my code

Sub AutomationStep1()

Dim Cl As Range, Rng As Range
Dim Cl2 As Range, Rng2 As Range
Dim Cl3 As Range, Rng3 As Range
Dim c As Range
Dim Cl4 As Range, Rng4 As Range
Dim Lastrow As Long
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "MW*" Then

For Each Cl In Range("A1:J1")
Select Case Cl.Value
Case "#", "Coupler Detached", "Coupler Attached", "Host Connected", "End Of File", "ms"
If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
End Select
Next Cl
If Not Rng Is Nothing Then Rng.EntireColumn.Delete

For Each Cl4 In Range("D1")
Select Case Cl4.Value
Case "Abs Pres (kPa) c:1 2"
If Rng4 Is Nothing Then Set Rng4 = Cl4 Else Set Rng4 = Union(Rng4, Cl4)
End Select
Next Cl4
If Not Rng4 Is Nothing Then
Application.ScreenUpdating = False

Lastrow = Cells(Rows.Count, "D").End(xlUp).Row
For Each c In Range("D2:D" & Lastrow)
c.Value = c.Value * 0.101972
Next
Application.ScreenUpdating = True

End If


For Each Cl2 In Range("A1:J1")
Select Case Cl2.Value
Case "Abs Pres (kPa) c:1 2"
If Rng2 Is Nothing Then Set Rng2 = Cl2 Else Set Rng = Union(Rng, Cl2)
End Select
Next Cl2
If Not Rng2 Is Nothing Then Rng2.Value = ("LEVEL")


For Each Cl3 In Range("A1:J1")
Select Case Cl3.Value
Case "Temp (°C) c:2"
If Rng3 Is Nothing Then Set Rng3 = Cl3 Else Set Rng = Union(Rng, Cl3)
End Select
Next Cl3
If Not Rng3 Is Nothing Then Rng3.Value = ("TEMPERATURE")
End If
Next ws
End Sub


EDIT:
My theory is that my ws loop doesnt work well, so the code cant work since the sheet is already processed
 
Last edited by a moderator:

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Try adding the instructions marked +++
VBA Code:
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "MW*" Then
    ws.Select               '+++ 11
    Set Rng = Nothing       '+++ 22
        For Each cl In Range("A1:J1")
            Select Case cl.Value
                Case "#", "Coupler Detached", "Coupler Attached", "Host Connected", "End Of File", "ms"
                If Rng Is Nothing Then Set Rng = cl Else Set Rng = Union(Rng, cl)
            End Select
        Next cl
        If Not Rng Is Nothing Then Rng.EntireColumn.Delete
    
    Set Rng4 = Nothing       '+++ 22
    For Each Cl4 In Range("D1")
        Select Case Cl4.Value
            Case "Abs Pres (kPa) c:1 2"
            If Rng4 Is Nothing Then Set Rng4 = Cl4 Else Set Rng4 = Union(Rng4, Cl4)
        End Select
    Next Cl4

'etc etc
'etc etc
That is:
-select the worksheet you are going to rework
-reset RngXX before using them on the new sheet. This means that the line marked +++ 22 need to be customized for each block

This minimizes the modifications to your code

PLEASE use "vba Tag" to make the code readable
 
Upvote 0
Try adding the instructions marked +++
VBA Code:
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "MW*" Then
    ws.Select               '+++ 11
    Set Rng = Nothing       '+++ 22
        For Each cl In Range("A1:J1")
            Select Case cl.Value
                Case "#", "Coupler Detached", "Coupler Attached", "Host Connected", "End Of File", "ms"
                If Rng Is Nothing Then Set Rng = cl Else Set Rng = Union(Rng, cl)
            End Select
        Next cl
        If Not Rng Is Nothing Then Rng.EntireColumn.Delete
   
    Set Rng4 = Nothing       '+++ 22
    For Each Cl4 In Range("D1")
        Select Case Cl4.Value
            Case "Abs Pres (kPa) c:1 2"
            If Rng4 Is Nothing Then Set Rng4 = Cl4 Else Set Rng4 = Union(Rng4, Cl4)
        End Select
    Next Cl4

'etc etc
'etc etc
That is:
-select the worksheet you are going to rework
-reset RngXX before using them on the new sheet. This means that the line marked +++ 22 need to be customized for each block

This minimizes the modifications to your code

PLEASE use "vba Tag" to make the code readable
I will use the tag in the future, sorry I'm still new.
What do you mean by customizing the +++22 lines for each block?
 
Upvote 0
What do you mean by customizing the +++22 lines for each block?
I mean that you have to set to "Nothing" the Rngxx you will use in that loop.
Thus
VBA Code:
Set Rng = Nothing       '+++ 22     THE FIRST BLOCK
...
Set Rng4 = Nothing       '+++ 22   THE SECOND BLOCK
....
 
Upvote 0
You must reference the ws object in each Range and in each Cell.
You can't use rng object on multiple sheets, so you have to initialize it for each sheet:

VBA Code:
Sub AutomationStep1()
  Dim Cl As Range, Rng As Range
  Dim Cl2 As Range, Rng2 As Range
  Dim Cl3 As Range, Rng3 As Range
  Dim c As Range
  Dim Cl4 As Range, Rng4 As Range
  Dim Lastrow As Long
  Dim ws As Worksheet
  
  For Each ws In ActiveWorkbook.Worksheets
    Set Rng = Nothing                     'Initialize the rng object
    Set Rng2 = Nothing                    'Initialize the rng object
    Set Rng3 = Nothing                    'Initialize the rng object
    Set Rng4 = Nothing                    'Initialize the rng object
    If ws.Name Like "MW*" Then
    
      For Each Cl In ws.Range("A1:J1")    'Make the reference to the ws object
        Select Case Cl.Value
          Case "#", "Coupler Detached", "Coupler Attached", "Host Connected", "End Of File", "ms"
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
        End Select
      Next Cl
      If Not Rng Is Nothing Then Rng.EntireColumn.Delete
      
      For Each Cl4 In ws.Range("D1")
        Select Case Cl4.Value
          Case "Abs Pres (kPa) c:1 2"
              If Rng4 Is Nothing Then Set Rng4 = Cl4 Else Set Rng4 = Union(Rng4, Cl4)
        End Select
      Next Cl4
      If Not Rng4 Is Nothing Then
        Lastrow = ws.Cells(Rows.Count, "D").End(xlUp).Row
        For Each c In ws.Range("D2:D" & Lastrow)
          c.Value = c.Value * 0.101972
        Next
      End If

      For Each Cl2 In ws.Range("A1:J1")
        Select Case Cl2.Value
        Case "Abs Pres (kPa) c:1 2"
          If Rng2 Is Nothing Then Set Rng2 = Cl2 Else Set Rng = Union(Rng, Cl2)
        End Select
      Next Cl2
      If Not Rng2 Is Nothing Then Rng2.Value = ("LEVEL")

      For Each Cl3 In ws.Range("A1:J1")
        Select Case Cl3.Value
        Case "Temp (°C) c:2"
          If Rng3 Is Nothing Then Set Rng3 = Cl3 Else Set Rng = Union(Rng, Cl3)
        End Select
      Next Cl3
      If Not Rng3 Is Nothing Then Rng3.Value = ("TEMPERATURE")
    End If
  Next ws
End Sub
 
Upvote 1
Solution
You must reference the ws object in each Range and in each Cell.
You can't use rng object on multiple sheets, so you have to initialize it for each sheet:

VBA Code:
Sub AutomationStep1()
  Dim Cl As Range, Rng As Range
  Dim Cl2 As Range, Rng2 As Range
  Dim Cl3 As Range, Rng3 As Range
  Dim c As Range
  Dim Cl4 As Range, Rng4 As Range
  Dim Lastrow As Long
  Dim ws As Worksheet
 
  For Each ws In ActiveWorkbook.Worksheets
    Set Rng = Nothing                     'Initialize the rng object
    Set Rng2 = Nothing                    'Initialize the rng object
    Set Rng3 = Nothing                    'Initialize the rng object
    Set Rng4 = Nothing                    'Initialize the rng object
    If ws.Name Like "MW*" Then
   
      For Each Cl In ws.Range("A1:J1")    'Make the reference to the ws object
        Select Case Cl.Value
          Case "#", "Coupler Detached", "Coupler Attached", "Host Connected", "End Of File", "ms"
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
        End Select
      Next Cl
      If Not Rng Is Nothing Then Rng.EntireColumn.Delete
     
      For Each Cl4 In ws.Range("D1")
        Select Case Cl4.Value
          Case "Abs Pres (kPa) c:1 2"
              If Rng4 Is Nothing Then Set Rng4 = Cl4 Else Set Rng4 = Union(Rng4, Cl4)
        End Select
      Next Cl4
      If Not Rng4 Is Nothing Then
        Lastrow = ws.Cells(Rows.Count, "D").End(xlUp).Row
        For Each c In ws.Range("D2:D" & Lastrow)
          c.Value = c.Value * 0.101972
        Next
      End If

      For Each Cl2 In ws.Range("A1:J1")
        Select Case Cl2.Value
        Case "Abs Pres (kPa) c:1 2"
          If Rng2 Is Nothing Then Set Rng2 = Cl2 Else Set Rng = Union(Rng, Cl2)
        End Select
      Next Cl2
      If Not Rng2 Is Nothing Then Rng2.Value = ("LEVEL")

      For Each Cl3 In ws.Range("A1:J1")
        Select Case Cl3.Value
        Case "Temp (°C) c:2"
          If Rng3 Is Nothing Then Set Rng3 = Cl3 Else Set Rng = Union(Rng, Cl3)
        End Select
      Next Cl3
      If Not Rng3 Is Nothing Then Rng3.Value = ("TEMPERATURE")
    End If
  Next ws
End Sub
It works! Thank you very much!
 
Upvote 0
I mean that you have to set to "Nothing" the Rngxx you will use in that loop.
Thus
VBA Code:
Set Rng = Nothing       '+++ 22     THE FIRST BLOCK
...
Set Rng4 = Nothing       '+++ 22   THE SECOND BLOCK
....
Thank you very much!
 
Upvote 0
Welcome to the MrExcel Message Board! :)

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0

Forum statistics

Threads
1,223,721
Messages
6,174,098
Members
452,542
Latest member
Bricklin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top