Macro not working correctly

[Andy_N1708 via OfficeKB.com]

Hello all,

I have written a macro that looks at one column of text and depending on what
is in the cell of that column, the macro would copy a template worksheet. The
macro works for the first cell in the column but then it defaulted back to
the last condition. I cannot get it to work correctly and hoping you guys can
give me some pointers. Below is the code for the macro...I appreciate the
help. Thanks.

Sub Test1()
Dim x As Integer
' Set numrows = number of rows of data.
NumRows = Range("B60", Range("B60").End(xlDown)).Rows.Count
' Select cell B601.
Range("B60").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows - 1
If Range("C60").Value = "A" Then
Sheets("Template A").Copy Before:=Sheets("End")
Sheets("Template A (2)").Name = "A" & Format(x, "000")
ElseIf Range("C60").Value = "B" Then
Sheets("Template B").Copy Before:=Sheets("End")
Sheets("Template B (2)").Name = "B" & Format(x, "000")
ElseIf Range("C60").Value = "C" Then
Sheets("Template C").Copy Before:=Sheets("End")
Sheets("Template C(2)").Name = "C" & Format(x, "000")
ElseIf Range("C60").Value = "Detail" Then
Sheets("Template D").Copy Before:=Sheets("End")
Sheets("Template D (2)").Name = "D" & Format(x, "000")
ElseIf Range("C60").Value = "" Then
Sheets("Template E").Copy Before:=Sheets("End")
Sheets("Template E (2)").Name = "E" & Format(x, "000")
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub

 

[Per Jessen]

Hi

Your macro is comparing af fixed cell in the loop (C60), use a variable to
hold the cell to compare. Also I would use a Case Select structure rather
than IF..Then...Else

Give this a try:

Sub Test1()
Dim x As Integer
Dim Criterium As Range
' Set numrows = number of rows of data.
NumRows = Range("B60", Range("B60").End(xlDown)).Rows.Count
Set Criterium = Range("C60")
' Select cell B601.
'Range("B60").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows - 1
Select Case Criterium
Case Is = "A"
Sheets("Template A").Copy Before:=Sheets("End")
Sheets("Template A (2)").Name = "A" & Format(x, "000")
Case Is = "B"
Sheets("Template B").Copy Before:=Sheets("End")
Sheets("Template B (2)").Name = "B" & Format(x, "000")
Case Is = "C"
Sheets("Template C").Copy Before:=Sheets("End")
Sheets("Template C(2)").Name = "C" & Format(x, "000")
Case Is = "Detail"
Sheets("Template D").Copy Before:=Sheets("End")
Sheets("Template D (2)").Name = "D" & Format(x, "000")
Case Is = ""
Sheets("Template E").Copy Before:=Sheets("End")
Sheets("Template E (2)").Name = "E" & Format(x, "000")
End Select
Set Criterium = Criterium.Offset(1, 0)
Next
End Sub

Regards,
Per

 

[Andy_N1708 via OfficeKB.com]

Hi Per,
Your code worked well. Thank you. However, using this method, I will be hard
coding the conditions, and that might not go well if people suddenly changed
the template names. So I need to make some improvements on this macro.

Hi

Your macro is comparing af fixed cell in the loop (C60), use a variable to
hold the cell to compare. Also I would use a Case Select structure rather
than IF..Then...Else

Give this a try:

Sub Test1()
Dim x As Integer
Dim Criterium As Range
' Set numrows = number of rows of data.
NumRows = Range("B60", Range("B60").End(xlDown)).Rows.Count
Set Criterium = Range("C60")
' Select cell B601.
'Range("B60").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows - 1
Select Case Criterium
Case Is = "A"
Sheets("Template A").Copy Before:=Sheets("End")
Sheets("Template A (2)").Name = "A" & Format(x, "000")
Case Is = "B"
Sheets("Template B").Copy Before:=Sheets("End")
Sheets("Template B (2)").Name = "B" & Format(x, "000")
Case Is = "C"
Sheets("Template C").Copy Before:=Sheets("End")
Sheets("Template C(2)").Name = "C" & Format(x, "000")
Case Is = "Detail"
Sheets("Template D").Copy Before:=Sheets("End")
Sheets("Template D (2)").Name = "D" & Format(x, "000")
Case Is = ""
Sheets("Template E").Copy Before:=Sheets("End")
Sheets("Template E (2)").Name = "E" & Format(x, "000")
End Select
Set Criterium = Criterium.Offset(1, 0)
Next
End Sub

Regards,
Per

Hello all,

[quoted text clipped - 35 lines]

Next
End Sub

 

[Per Jessen]

Hi Andy,

Thanks for your reply.

A few things you can do to prevent people from changing template
names.

If user do not need to see the template sheets, you can just hide the
sheets. Set the Visible property of the worksheets to VeryHidden, then
sheets can only be made visible by code, but you can still copy them.

Another option is to protect the workbook for structure, then user can
not change any sheet names nor can he add or delete sheets. If you
choose this method, your code has to unprotect the workbook, before it
copies and rename the sheet(s).

Sub Test1()
Dim pWord as String

pWord="JustMe"' change to suit
ThisWorkbook.Unprotect Password:=pWord

'Your curretnt code

ThisWorkbook.Protect Password:= pWord
End Sub

Hopes this helps
....
Per

Hi Per,
Your code worked well.  Thank you. However, using this method, I will be hard
coding the conditions, and that might not go well if people suddenly changed
the template names. So I need to make some improvements on this macro.

Hi

Your macro is comparing af fixed cell in the loop (C60), use a variable to
hold the cell to compare. Also I would use a Case Select structure rather
than IF..Then...Else

Give this a try:

Sub Test1()
Dim x As Integer
Dim Criterium As Range
' Set numrows = number of rows of data.
NumRows = Range("B60", Range("B60").End(xlDown)).Rows.Count
Set Criterium = Range("C60")
' Select cell B601.
'Range("B60").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows - 1
   Select Case Criterium
   Case Is = "A"
       Sheets("Template A").Copy Before:=Sheets("End")
       Sheets("Template A (2)").Name = "A" & Format(x, "000")
   Case Is = "B"
       Sheets("Template B").Copy Before:=Sheets("End")
       Sheets("Template B (2)").Name = "B" & Format(x, "000")
   Case Is = "C"
       Sheets("Template C").Copy Before:=Sheets("End")
       Sheets("Template C(2)").Name = "C" & Format(x, "000")
   Case Is = "Detail"
       Sheets("Template D").Copy Before:=Sheets("End")
       Sheets("Template D (2)").Name = "D" & Format(x, "000")
   Case Is = ""
       Sheets("Template E").Copy Before:=Sheets("End")
       Sheets("Template E (2)").Name = "E" & Format(x, "000")
   End Select
   Set Criterium = Criterium.Offset(1, 0)
Next
End Sub

[quoted text clipped - 35 lines]

     Next
  End Sub