[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Clear Multiple Ranges in Multiple Worksheets

Posted on 2011-10-24
30
Medium Priority
?
223 Views
Last Modified: 2012-06-27
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
Comment
Question by:Cacique610
  • 9
  • 8
  • 6
  • +3
30 Comments
 

Author Comment

by:Cacique610
ID: 37019716
Sorry it is an Excel 2003 vba
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 37019798
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
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 37019811
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 37019815
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
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 37019822
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
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 37019841
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
 

Author Comment

by:Cacique610
ID: 37019923
I am trying to clear the content

indeed
r#.ClearContent is needed.

0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 37019936
Make sure it is

r#.clearcontents

and not

r#.clearcontent
0
 

Author Comment

by:Cacique610
ID: 37019957
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
 
LVL 35

Expert Comment

by:Norie
ID: 37020000
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
 

Author Comment

by:Cacique610
ID: 37020035
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
 
LVL 35

Expert Comment

by:Norie
ID: 37020070
Does the original code you posted work?

That's where I took the worksheet and range names from.
0
 

Author Comment

by:Cacique610
ID: 37020090
I was getting 1004 also
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 37020125
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
 
LVL 35

Expert Comment

by:Norie
ID: 37020136
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
 

Author Comment

by:Cacique610
ID: 37020236
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
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 37020273
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
 
LVL 35

Expert Comment

by:Norie
ID: 37020294
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
 

Author Comment

by:Cacique610
ID: 37020299
Wil try that really quick
0
 

Author Comment

by:Cacique610
ID: 37020339
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
 

Author Comment

by:Cacique610
ID: 37020350
Just in case but this is for Excel 2003.
0
 
LVL 35

Expert Comment

by:Norie
ID: 37020409
The version shouldn't matter.

Is it working?
0
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 37020417
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
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 37020429
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
 
LVL 35

Expert Comment

by:Norie
ID: 37022181
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
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 37022301
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
 
LVL 35

Expert Comment

by:Norie
ID: 37023569
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
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 2000 total points
ID: 37023803
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
 
LVL 35

Expert Comment

by:Norie
ID: 37023843
rory

Not sure about that.

0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 37025709
@imnorie,
You are correct - I miscounted the arrays.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this post, I will showcase the steps for how to create groups in Office 365. Office 365 groups allow for ease of flexibility and collaboration between staff members.
Sometimes MS breaks things just for fun... In Access 2003, only the maximum allowable SQL string length could cause problems as you built a recordset. Now, when using string data in a WHERE clause, the 'identifier' maximum is 128 characters. So, …
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …

830 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question