ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Shortening a Macro (https://www.excelbanter.com/excel-programming/365167-shortening-macro.html)

Paul Sheppard[_16_]

Shortening a Macro
 

I am using excel 2000 and have a workbook with 2 sheets, Targets and
Individual Store Targets

The Target Sheet has the the Store Name in column A, and various
targets in columns B, C, D & E, the data starts in Row 4 and currently
goes down to row 81 but is constantly increasing

On the Individual Store Targets sheet I have links to the data on the
Targets sheet and I wrote a macro to change the links to each stores
name and targets and print it,my code is below:

[color="Red"]Sub PrintIndividualStoreTargets()
'
' PrintIndividualStoreTargets Macro
' Macro recorded 19/12/2005 by
'

'
Sheets("Individual Store Targets").Visible = True
Sheets("Individual Store Targets").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("A3:D3,A6,B6,C6,D6").Select
Range("D6").Activate
Selection.Replace What:="4", Replacement:="5", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.Replace What:="5", Replacement:="6", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.Replace What:="6", Replacement:="7", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

etc down to 81 and finishes with:

Selection.Replace What:="81", Replacement:="4", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("A2").Select
Sheets("Individual Store Targets").Visible = False

Is there any way this code could be shortened and written in a way that
each time I add a new store it automatically picks it up instead of
having to add the the edit replace for the new store

Thanks in advance


--
Paul Sheppard


------------------------------------------------------------------------
Paul Sheppard's Profile: http://www.excelforum.com/member.php...o&userid=24783
View this thread: http://www.excelforum.com/showthread...hreadid=554863


Mike Fogleman

Shortening a Macro
 
Paul, try this and let us know:

Sub PrintIndividualStoreTargets()
' PrintIndividualStoreTargets Macro
Dim i As Long, ii As Long
Dim FRow As Long
Dim LRow As Long
Dim Rng As Range


Sheets("Target").Activate
LRow = Cells(Rows.Count, "A").End(xlUp).Row
FRow = 4
Set Rng = Sheets("Individual Store Targets").Range("A3:D3,A6,B6,C6,D6")
Rng.PrintOut

For i = FRow To LRow
ii = i + 1
With Rng
.Replace What:=i, Replacement:=ii, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
.PrintOut
If i = LRow Then
.Replace What:=i, Replacement:=FRow, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Exit Sub
End If
End With
Next i
End Sub


Mike F
"Paul Sheppard"
wrote in message
news:Paul.Sheppard.29ud35_1151043522.1273@excelfor um-nospam.com...[color=blue]

I am using excel 2000 and have a workbook with 2 sheets, Targets and
Individual Store Targets

The Target Sheet has the the Store Name in column A, and various
targets in columns B, C, D & E, the data starts in Row 4 and currently
goes down to row 81 but is constantly increasing

On the Individual Store Targets sheet I have links to the data on the
Targets sheet and I wrote a macro to change the links to each stores
name and targets and print it,my code is below:

Sub PrintIndividualStoreTargets()
'
' PrintIndividualStoreTargets Macro
' Macro recorded 19/12/2005 by
'

'
Sheets("Individual Store Targets").Visible = True
Sheets("Individual Store Targets").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("A3:D3,A6,B6,C6,D6").Select
Range("D6").Activate
Selection.Replace What:="4", Replacement:="5", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.Replace What:="5", Replacement:="6", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.Replace What:="6", Replacement:="7", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

etc down to 81 and finishes with:

Selection.Replace What:="81", Replacement:="4", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("A2").Select
Sheets("Individual Store Targets").Visible = False

Is there any way this code could be shortened and written in a way that
each time I add a new store it automatically picks it up instead of
having to add the the edit replace for the new store

Thanks in advance


--
Paul Sheppard


------------------------------------------------------------------------
Paul Sheppard's Profile:
http://www.excelforum.com/member.php...o&userid=24783
View this thread: http://www.excelforum.com/showthread...hreadid=554863




Paul Sheppard[_17_]

Shortening a Macro
 

Hi Mike

Thanks for this, unfortunately it does not work, the macro appears to
run in the background, but nothing prints

Paul


--
Paul Sheppard


------------------------------------------------------------------------
Paul Sheppard's Profile: http://www.excelforum.com/member.php...o&userid=24783
View this thread: http://www.excelforum.com/showthread...hreadid=554863


Mike Fogleman

Shortening a Macro
 
Sorry, I didn't have time to test it this morning. This tests OK for me, try
it and let me know. The printout sheet needs to be visible in order to print
it, but not necessarily the active sheet. Fixed that. Also had the IF
statement in the wrong place to stop printing and return the cell references
back to row 4. Fixed that. If the print sheet was visible then it printed
each cell range on a separate page. Fixed that.
I guess I really blew it this morning, but this should make up for it.

Sub PrintIndividualStoreTargets()
' PrintIndividualStoreTargets Macro
Dim i As Long, ii As Long
Dim FRow As Long
Dim LRow As Long
Dim Rng As Range

Sheets("Individual Store Targets").Visible = True
Sheets("Target").Activate
LRow = Cells(Rows.Count, "A").End(xlUp).Row
FRow = 4

Set Rng = Sheets("Individual Store Targets").Range("A3:D3,A6:D6")
Worksheets("Individual Store Targets").PrintOut

For i = FRow To LRow
ii = i + 1
If i = LRow Then
Rng.Replace What:=i, Replacement:=FRow, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Exit Sub
End If

With Rng
.Replace What:=i, Replacement:=ii, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Worksheets("Individual Store Targets").PrintOut
End With

Next i

Sheets("Individual Store Targets").Visible = False
End Sub

Good luck,
Mike F

"Paul Sheppard"
wrote in message
news:Paul.Sheppard.29v3pd_1151077805.1634@excelfor um-nospam.com...

Hi Mike

Thanks for this, unfortunately it does not work, the macro appears to
run in the background, but nothing prints

Paul


--
Paul Sheppard


------------------------------------------------------------------------
Paul Sheppard's Profile:
http://www.excelforum.com/member.php...o&userid=24783
View this thread: http://www.excelforum.com/showthread...hreadid=554863




Paul Sheppard[_18_]

Shortening a Macro
 

Thanks Mike that worked and will save time as I add more rows


--
Paul Sheppard


------------------------------------------------------------------------
Paul Sheppard's Profile: http://www.excelforum.com/member.php...o&userid=24783
View this thread: http://www.excelforum.com/showthread...hreadid=554863



All times are GMT +1. The time now is 04:45 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com