• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 226
  • Last Modified:

Clear Multiple Ranges in Multiple Worksheets

I wouls like to clear Multiple ranges value located in different Worksheets with a VBA script.

These are the Sheet anmes and the ranges.

Sub Clear_Multiple_Ranges()

Dim i As Integer
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim r4 As Range
Dim r5 As Range
Dim r6 As Range
Dim r7 As Range
Dim r8 As Range
Dim r9 As Range
Dim r10 As Range
Dim r11 As Range
Dim r12 As Range
Dim r13 As Range
Dim r14 As Range
Dim r15 As Range
Dim r16 As Range
Dim r17 As Range
Dim r18 As Range
Dim r19 As Range
Dim r20 As Range
Dim r21 As Range
Dim r22 As Range
Dim r23 As Range
Dim r24 As Range


Set r1 = Sheets("Report").Range("AIL")
Set r2 = Sheets("Report").Range("Execsum")
Set r3 = Sheets("Report").Range("Impeddisc")
Set r4 = Sheets("Report").Range("Collectexp")

Set r5 = Sheets("Inputs and Calcs").Range("Rptdate")
Set r6 = Sheets("Inputs and Calcs").Range("Recprof")
Set r7 = Sheets("Inputs and Calcs").Range("BSdrill1")
Set r8 = Sheets("Inputs and Calcs").Range("BSdrill2")
Set r9 = Sheets("Inputs and Calcs").Range("ABAL1")
Set r10 = Sheets("Inputs and Calcs").Range("ABAL2")
Set r11 = Sheets("Inputs and Calcs").Range("ABAL3")
Set r12 = Sheets("Inputs and Calcs").Range("Counts4C")
Set r13 = Sheets("Inputs and Calcs").Range("Recsum1")
Set r14 = Sheets("Inputs and Calcs").Range("Recsum2")
Set r15 = Sheets("Inputs and Calcs").Range("Recsum3")
Set r16 = Sheets("Inputs and Calcs").Range("Imped1")
Set r17 = Sheets("Inputs and Calcs").Range("Imped2")
Set r18 = Sheets("Inputs and Calcs").Range("Impedsum")
Set r19 = Sheets("Inputs and Calcs").Range("Lossshr1")
Set r20 = Sheets("Inputs and Calcs").Range("Lossshr2")
Set r21 = Sheets("Inputs and Calcs").Range("Lossshr3")
Set r22 = Sheets("Inputs and Calcs").Range("Prumoo")

Set r23 = Sheets("Raw Data BS").Range("NFEbs")

Set r24 = Sheets("Raw Data Trend").Range("NFEts")

   

End Sub
0
Cacique610
Asked:
Cacique610
  • 9
  • 8
  • 6
  • +3
1 Solution
 
Cacique610Author Commented:
Sorry it is an Excel 2003 vba
0
 
Rey Obrero (Capricorn1)Commented:
try this codes


Sub delRange()
Dim xlObj As Object, j As Integer
Set xlObj = CreateObject("excel.application")
    xlObj.workbooks.Open "C:\myExcel.xls"
    With xlObj
        For j = .names.Count To 1 Step -1
 
            .names(j).Delete
        Next
    End With
    xlObj.Quit

End Sub
0
 
Glenn RayExcel VBA DeveloperCommented:
I'm not sure why you are assigning the ranges in a subroutine that is titled "Clear_Multiple_Ranges", but I suggest revising your code to assign the ranges to an array variable instead.  You can then clear the ranges via a loop using your integer variable (i).

You would then probably have two separate routines as so:

   
Sub Assign_Multiple_Ranges()
    Dim r(24) As Range
    Set r(1) = Sheets("Report").Range("AIL")
    Set r(2) = Sheets("Report").Range("Execsum")
    Set r(3) = Sheets("Report").Range("Impeddisc")
    Set r(4) = Sheets("Report").Range("Collectexp")
    Set r(5) = Sheets("Inputs and Calcs").Range("Rptdate")
    Set r(6) = Sheets("Inputs and Calcs").Range("Recprof")
    Set r(7) = Sheets("Inputs and Calcs").Range("BSdrill1")
    Set r(8) = Sheets("Inputs and Calcs").Range("BSdrill2")
    Set r(9) = Sheets("Inputs and Calcs").Range("ABAL1")
    Set r(10) = Sheets("Inputs and Calcs").Range("ABAL2")
    Set r(11) = Sheets("Inputs and Calcs").Range("ABAL3")
    Set r(12) = Sheets("Inputs and Calcs").Range("Counts4C")
    Set r(13) = Sheets("Inputs and Calcs").Range("Recsum1")
    Set r(14) = Sheets("Inputs and Calcs").Range("Recsum2")
    Set r(15) = Sheets("Inputs and Calcs").Range("Recsum3")
    Set r(16) = Sheets("Inputs and Calcs").Range("Imped1")
    Set r(17) = Sheets("Inputs and Calcs").Range("Imped2")
    Set r(18) = Sheets("Inputs and Calcs").Range("Impedsum")
    Set r(19) = Sheets("Inputs and Calcs").Range("Lossshr1")
    Set r(20) = Sheets("Inputs and Calcs").Range("Lossshr2")
    Set r(21) = Sheets("Inputs and Calcs").Range("Lossshr3")
    Set r(22) = Sheets("Inputs and Calcs").Range("Prumoo")
    Set r(23) = Sheets("Raw Data BS").Range("NFEbs")
    Set r(24) = Sheets("Raw Data Trend").Range("NFEts")
End Sub

Sub Clear_Multiple_Ranges()
    Dim r(24) As Range
    Dim i As Integer
    For i = 1 To 24
        r(i).ClearContents
    Next i
End Sub

Open in new window

0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

 
Rey Obrero (Capricorn1)Commented:
in excel use this


Sub delRange()
 
Dim j As Integer
With ActiveWorkbook
For j = .Names.Count To 1 Step -1
     .Names(j).Delete
Next
End With
End Sub
0
 
Saqib Husain, SyedEngineerCommented:
I thought that the OP wanted to clear the values. If that is the case then he needs something like

r1.clearcontents
r2.clearcontents
r3.clearcontents
r4.clearcontents
.
.
.
0
 
Glenn RayExcel VBA DeveloperCommented:
Sorry, that's not correct.  

The dimension statement for the range should be outside the subroutines on top and removed from the inside of each routine
Dim r(24) As Range
Sub Assign_Multiple_Ranges()
    Set r(1) = Sheets("Report").Range("AIL")
    Set r(2) = Sheets("Report").Range("Execsum")
    Set r(3) = Sheets("Report").Range("Impeddisc")
    Set r(4) = Sheets("Report").Range("Collectexp")
    Set r(5) = Sheets("Inputs and Calcs").Range("Rptdate")
    Set r(6) = Sheets("Inputs and Calcs").Range("Recprof")
    Set r(7) = Sheets("Inputs and Calcs").Range("BSdrill1")
    Set r(8) = Sheets("Inputs and Calcs").Range("BSdrill2")
    Set r(9) = Sheets("Inputs and Calcs").Range("ABAL1")
    Set r(10) = Sheets("Inputs and Calcs").Range("ABAL2")
    Set r(11) = Sheets("Inputs and Calcs").Range("ABAL3")
    Set r(12) = Sheets("Inputs and Calcs").Range("Counts4C")
    Set r(13) = Sheets("Inputs and Calcs").Range("Recsum1")
    Set r(14) = Sheets("Inputs and Calcs").Range("Recsum2")
    Set r(15) = Sheets("Inputs and Calcs").Range("Recsum3")
    Set r(16) = Sheets("Inputs and Calcs").Range("Imped1")
    Set r(17) = Sheets("Inputs and Calcs").Range("Imped2")
    Set r(18) = Sheets("Inputs and Calcs").Range("Impedsum")
    Set r(19) = Sheets("Inputs and Calcs").Range("Lossshr1")
    Set r(20) = Sheets("Inputs and Calcs").Range("Lossshr2")
    Set r(21) = Sheets("Inputs and Calcs").Range("Lossshr3")
    Set r(22) = Sheets("Inputs and Calcs").Range("Prumoo")
    Set r(23) = Sheets("Raw Data BS").Range("NFEbs")
    Set r(24) = Sheets("Raw Data Trend").Range("NFEts")
End Sub
Sub Clear_Multiple_Ranges()
    Dim i As Integer
    For i = 1 To 24
        r(i).ClearContents
    Next i
End Sub

Open in new window

0
 
Cacique610Author Commented:
I am trying to clear the content

indeed
r#.ClearContent is needed.

0
 
Saqib Husain, SyedEngineerCommented:
Make sure it is

r#.clearcontents

and not

r#.clearcontent
0
 
Cacique610Author Commented:
How do I run this?
Dim r(24) As Range
Sub Assign_Multiple_Ranges()
    Set r(1) = Sheets("Report").Range("AIL")
    Set r(2) = Sheets("Report").Range("Execsum")
    Set r(3) = Sheets("Report").Range("Impeddisc")
    Set r(4) = Sheets("Report").Range("Collectexp")
    Set r(5) = Sheets("Inputs and Calcs").Range("Rptdate")
    Set r(6) = Sheets("Inputs and Calcs").Range("Recprof")
    Set r(7) = Sheets("Inputs and Calcs").Range("BSdrill1")
    Set r(8) = Sheets("Inputs and Calcs").Range("BSdrill2")
    Set r(9) = Sheets("Inputs and Calcs").Range("ABAL1")
    Set r(10) = Sheets("Inputs and Calcs").Range("ABAL2")
    Set r(11) = Sheets("Inputs and Calcs").Range("ABAL3")
    Set r(12) = Sheets("Inputs and Calcs").Range("Counts4C")
    Set r(13) = Sheets("Inputs and Calcs").Range("Recsum1")
    Set r(14) = Sheets("Inputs and Calcs").Range("Recsum2")
    Set r(15) = Sheets("Inputs and Calcs").Range("Recsum3")
    Set r(16) = Sheets("Inputs and Calcs").Range("Imped1")
    Set r(17) = Sheets("Inputs and Calcs").Range("Imped2")
    Set r(18) = Sheets("Inputs and Calcs").Range("Impedsum")
    Set r(19) = Sheets("Inputs and Calcs").Range("Lossshr1")
    Set r(20) = Sheets("Inputs and Calcs").Range("Lossshr2")
    Set r(21) = Sheets("Inputs and Calcs").Range("Lossshr3")
    Set r(22) = Sheets("Inputs and Calcs").Range("Prumoo")
    Set r(23) = Sheets("Raw Data BS").Range("NFEbs")
    Set r(24) = Sheets("Raw Data Trend").Range("NFEts")
End Sub
Sub Clear_Multiple_Ranges()
    Dim i As Integer
    For i = 1 To 24
        r(i).ClearContents
    Next i
End Sub 

Open in new window

0
 
NorieVBA ExpertCommented:
Try this.
Dim rng As Range
Dim arrWSs
Dim arrRngs
Dim I As Long

arrWSs = Array("Report", "Report", "Report", "Report", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Raw Data BS", "Raw Data Trend")
arrRngs = Array("AIL", "Execsum", "Impeddisc", "Collectexp", "Rptdate", "Recprof", "BSdrill1", "BSdrill2", _
                      "ABAL1", "ABAL2", "ABAL3", "Counts4C", "Recsum1", "Recsum2", "Recsum3", "Imped1", _
                      "Imped2", "Impedsum", "Lossshr1", "Lossshr2", "Lossshr3", "Prumoo", "NFEbs", "NFEts")


For I = LBound(arrWSs) To UBound(arrWSs)

    Set rng = Worksheets(arrWSs(I)).Range(arrRngs(I))
   ' Debug.Print arrWSs(I) & "!" & arrRngs(I)
    rng.ClearContents
    
Next I

Open in new window

0
 
Cacique610Author Commented:
I am getting error 1004

Dim rng As Range
Dim arrWSs
Dim arrRngs
Dim I As Long

arrWSs = Array("Report", "Report", "Report", "Report", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Raw Data BS", "Raw Data Trend")
arrRngs = Array("AIL", "Execsum", "Impeddisc", "Collectexp", "Rptdate", "Recprof", "BSdrill1", "BSdrill2", _
                      "ABAL1", "ABAL2", "ABAL3", "Counts4C", "Recsum1", "Recsum2", "Recsum3", "Imped1", _
                      "Imped2", "Impedsum", "Lossshr1", "Lossshr2", "Lossshr3", "Prumoo", "NFEbs", "NFEts")


For I = LBound(arrWSs) To UBound(arrWSs)

    Set rng = Worksheets(arrWSs(I)).Range(arrRngs(I))
   ' Debug.Print arrWSs(I) & "!" & arrRngs(I)
    rng.ClearContents
    
Next I

Open in new window

0
 
NorieVBA ExpertCommented:
Does the original code you posted work?

That's where I took the worksheet and range names from.
0
 
Cacique610Author Commented:
I was getting 1004 also
0
 
Saqib Husain, SyedEngineerCommented:
First farmer: What did you give to your cow when it was sick?
Second farmer: Turpentine oil.

A few days later

First farmer: I gave my cow turpentine oil and it died
Second farmer: So did mine.....
0
 
NorieVBA ExpertCommented:
That could mean that some of the worksheet/range names are incorrect.

What's the actual error message?

A quick fix would be to add On Error Resume Next to the code but that might not be a good idea if you are automating Excel from Access.

If the code is in Excel this is how adding On Error would look.
For I = LBound(arrWSs) To UBound(arrWSs)
    On Error Resume Next
    Set rng = Worksheets(arrWSs(I)).Range(arrRngs(I))
   ' Debug.Print arrWSs(I) & "!" & arrRngs(I)
    rng.ClearContents
    
    On Error GoTo 0
    
Next I

Open in new window

0
 
Cacique610Author Commented:
Run time error 1004
Application -Defined  or object define error

then it points to this statement
Set rng = Worksheets(arrWSs(I)).Range(arrRngs(I))
0
 
Glenn RayExcel VBA DeveloperCommented:
imnorie is correct:  one or more of your range names (and/or worksheet names) are either missing or not spelled exactly as you specified in the original post.

You need to review all the range names and ensure that they exist and then adjust the code appropriately.
0
 
NorieVBA ExpertCommented:
The code I posted with the On Error added works fine for me in Excel VBA, and I have none of those worksheets or ranges.
0
 
Cacique610Author Commented:
Wil try that really quick
0
 
Cacique610Author Commented:
This is the code as it is in the Module. I found no errors on the range names and worksheets.
Sub Reset()


Dim rng As Range
Dim arrWSs
Dim arrRngs
Dim I As Long




arrWSs = Array("Report", "Report", "Report", "Report", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                      "Inputs and Calcs", "Inputs and Calcs", "Raw Data BS", "Raw Data Trend")
arrRngs = Array("AIL", "Execsum", "Impeddisc", "Collectexp", "Rptdate", "Recprof", "BSdrill1", "BSdrill2", _
                      "ABAL1", "ABAL2", "ABAL3", "Counts4C", "Recsum1", "Recsum2", "Recsum3", "Imped1", _
                      "Imped2", "Impedsum", "Lossshr1", "Lossshr2", "Lossshr3", "Prumoo", "NFEbs", "NFEts")


For I = LBound(arrWSs) To UBound(arrWSs)

    Set rng = Worksheets(arrWSs(I)).Range(arrRngs(I))
   ' Debug.Print arrWSs(I) & "!" & arrRngs(I)
    rng.ClearContents
    
Next I

End Sub

Open in new window

0
 
Cacique610Author Commented:
Just in case but this is for Excel 2003.
0
 
NorieVBA ExpertCommented:
The version shouldn't matter.

Is it working?
0
 
Glenn RayExcel VBA DeveloperCommented:
To see what range/sheet is causing the 1004 error, replace the following lines in imnorie's code (from lines 23-29 in your example above)
For I = LBound(arrWSs) To UBound(arrWSs)
    On Error Goto ErrOut
    Set rng = Worksheets(arrWSs(I)).Range(arrRngs(I))
    rng.ClearContents 
Next I
Exit Sub

ErrOut:
    Msgbox "Cannot find Range: " & arrRngs(I) & " on worksheet: " & arr(WSs(I)

Open in new window

0
 
Glenn RayExcel VBA DeveloperCommented:
oops...last line shouldn't have that extra opening paranthesis:

Msgbox "Cannot find Range: " & arrRngs(I) & " on worksheet: " & arrWSs(I)

Open in new window

0
 
NorieVBA ExpertCommented:
Glenn

Won't that jump out of the loop when the first error occurs?

I can't make my mind up whether that's a good or bad thing.

If there's a few problems it might be OK but if there's a lot I'm not so sure.

I think what I would do is set it up to go through the whole loop and report the problem ranges at the end.
0
 
Glenn RayExcel VBA DeveloperCommented:
imnorie, yes it will.  

IMO, if there are many errors, it calls into question the whole approach (i.e., not knowing the proper range names).  I presumed that there would be just one or two possible errors (ex., spelling only).

And while I agree it would be more thorough to capture all possible errors and report afterward, solutions have been offered here on the assumption that the original data was accurate.

BTW, I like your array assignment best.
0
 
NorieVBA ExpertCommented:
Glenn

I was kind of pinning my hopes on it being a misspelled sheet name rather than individual range names.

Or perhaps some sort of pattern, eg every range name has a trailing space.

If you had a log that might help.

Anyway, suppose we'll just need to wait and see.
0
 
Rory ArchibaldCommented:
You appear to be missing a loop:

Sub Reset()
   Dim rng               As Range
   Dim arrWSs
   Dim arrRngs
   Dim I                 As Long
   Dim J                 As Long

   arrWSs = Array("Report", "Report", "Report", "Report", _
                  "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                  "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                  "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                  "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", "Inputs and Calcs", _
                  "Inputs and Calcs", "Inputs and Calcs", "Raw Data BS", "Raw Data Trend")
   arrRngs = Array("AIL", "Execsum", "Impeddisc", "Collectexp", "Rptdate", "Recprof", "BSdrill1", "BSdrill2", _
                   "ABAL1", "ABAL2", "ABAL3", "Counts4C", "Recsum1", "Recsum2", "Recsum3", "Imped1", _
                   "Imped2", "Impedsum", "Lossshr1", "Lossshr2", "Lossshr3", "Prumoo", "NFEbs", "NFEts")


   For I = LBound(arrWSs) To UBound(arrWSs)
      For J = LBound(arrRngs) To UBound(arrRngs)
         Set rng = Worksheets(arrWSs(I)).Range(arrRngs(J))
         ' Debug.Print arrWSs(I) & "!" & arrRngs(I)
         rng.ClearContents
      Next J
   Next I

End Sub

Open in new window

0
 
NorieVBA ExpertCommented:
rory

Not sure about that.

0
 
Rory ArchibaldCommented:
@imnorie,
You are correct - I miscounted the arrays.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 9
  • 8
  • 6
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now