Macro adds "=" to each cell in defined range across multiple worksheets

A

abbruno

I have the following macro that works great on a single worksheet.
However, I need to get this to loop through a workbook. What is th
most efficient way to do this?

Thanks for your help!


Option Explicit
Sub Set_Q2_Targets()

Dim myRng As Range
Dim myCell As Range

Set myRng = Nothing

On Error Resume Next
With Worksheets("Home Equity First Lien")
Set myRng = .Range("N14", .Cells(.Rows.Count, "N").End(xlUp)) _
.SpecialCells(xlCellTypeConstants)
End With
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "Macro Error"
Exit Sub
End If

For Each myCell In myRng.Cells
With myCell
.NumberFormat = "General"
.Formula = "=" & .Value
End With
Next myCell

End Su
 
J

joeu2004

abbruno said:
I have the following macro that works great on a single
worksheet. However, I need to get this to loop through
a workbook. What is the most efficient way to do this?


Option Explicit
Sub Set_Q2_Targets()

Dim myRng As Range
Dim myCell As Range
Dim sh As Worksheet '<<<<<

For Each sh In Sheets '<<<<<
Set myRng = Nothing

On Error Resume Next
With sh '<<<<<
Set myRng = .Range("N14", .Cells(.Rows.Count, "N").End(xlUp)) _
SpecialCells(xlCellTypeConstants)
End With
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "Macro Error"
Exit Sub
End If

myRng.NumberFormat = "General" '<<<< improvement
For Each myCell In myRng.Cells
With myCell
..Formula = "=" & .Value '<<<< fixed defect
End With
Next myCell
Next sh '<<<<

End Sub


If you want to do this only on selective worksheets:

Dim shName as String
For Each shName in Array("This Sheet","That Sheet","etc")
Set myRng = Nothing
On Error Resume Next
With Sheets(shName)
Set myRng = .Range(...)....
' .... rest of code ....
Next myCell
Next shName
 
J

joeu2004

PS.... I said:
myRng.NumberFormat = "General" '<<<< improvement
For Each myCell In myRng.Cells
With myCell
.Formula = "=" & .Value '<<<< fixed defect
End With
Next myCell

You might consider the following:

Set myCell = ActiveCell
myRng.NumberFormat = "General"
myRng.Copy
myRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
myCell.Activate
 
A

abbruno

Thank you for the response!

I am new to VBA, and I have added a couple of things to my code an
maybe that is interfering with the code as you had written.
The things I am trying to accomplish in addition to the code below are:

- Copy, paste special, values in column K
- "clean up" the worksheets by freezing panes, selecting cell D14
scrolling to the top and far left and closing any open groupings.

Something I added must be making the code not work properly. I a
getting a compile error (For Each control variable must be variant o
object) Can you please tell me what is wrong and how to fix this? Her
is what I have now based on the previous post.

Thanks again for any help you can provide!


Sub Set_Q2_Targets()

Dim myRng As Range
Dim myCell As Range
Dim sh As Worksheet
Dim shName As String
For Each shName In Array("Home Equity First Lien", "Home Equity Loans
Lines", "Unsecured Loans & Lines", "Installment", "Project Gold"
"Business Leases", "Personal Checking", "Business Checking", "Savings
Money Market", "CDs")

Set myRng = Nothing

On Error Resume Next
With Sheets(shName)
Range("K14:K120").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
Set myRng = .Range("Z14", .Cells(.Rows.Count, "Z").End(xlUp)) _
.SpecialCells(xlCellTypeConstants)
End With
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "Macro Error"
Exit Sub
End If

myRng.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
For Each myCell In myRng.Cells
With myCell
.Formula = "=" & .Value
End With
Range("D14").Select
ActiveWindow.FreezePanes = True
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
ActiveSheet.Outline.ShowLevels RowLevels:=1
Next myCell
Next shName
End Sub


'joeu2004[_2_ said:
;1606836']"abbruno said:
I have the following macro that works great on a single
worksheet. However, I need to get this to loop through
a workbook. What is the most efficient way to do this?-


Option Explicit
Sub Set_Q2_Targets()

Dim myRng As Range
Dim myCell As Range
Dim sh As Worksheet '<<<<<

For Each sh In Sheets '<<<<<
Set myRng = Nothing

On Error Resume Next
With sh '<<<<<
Set myRng = .Range("N14", .Cells(.Rows.Count, "N").End(xlUp)) _
SpecialCells(xlCellTypeConstants)
End With
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "Macro Error"
Exit Sub
End If

myRng.NumberFormat = "General" '<<<< improvement
For Each myCell In myRng.Cells
With myCell
..Formula = "=" & .Value '<<<< fixed defect
End With
Next myCell
Next sh '<<<<

End Sub


If you want to do this only on selective worksheets:

Dim shName as String
For Each shName in Array("This Sheet","That Sheet","etc")
Set myRng = Nothing
On Error Resume Next
With Sheets(shName)
Set myRng = .Range(...)....
' .... rest of code ....
Next myCell
Next shNam
 
J

joeu2004

abbruno said:
I am getting a compile error (For Each control variable
must be variant or object) Can you please tell me what
is wrong and how to fix this?

My bad! Sometimes I forget VBA's subtle foibles.

Fix this problem by changing the type of shName from String to Variant.
That is:

Dim shName As Variant

I did not sanity-check the rest of the code.
 
A

abbruno

This worked great!!! I did have to move around some of my other code t
get r working properly, but it is doing just what I wanted it to now.

Thanks again!

'joeu2004[_2_ said:
;1606862']"abbruno said:
I am getting a compile error (For Each control variable
must be variant or object) Can you please tell me what
is wrong and how to fix this?-

My bad! Sometimes I forget VBA's subtle foibles.

Fix this problem by changing the type of shName from String to Variant

That is:

Dim shName As Variant

I did not sanity-check the rest of the code
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top