Use variable with Sheet Codenames

[jwilder1]

5992I would like to use a variable with sheet codenames to loop through copying between pairs of worksheets, ex. codename B1 to codename P1, B2 to P2, etc. When distributed, users are likely to rename sheets. The following procedure works, but I have to repeat the formula for each loop. Have searched but could not find how to use a variable with the codename.
Sub CtCreat()
Dim Ct As Long
Dim X As Long
'Determine number of sheets to work with
Ct = ThisWorkbook.Sheets("Start").Range("B1").Value
'Loop through varable number of sheets
'using Sheet codenames to copy
'B(X) will always copy to P(X)
For X = 1 To Ct
Select Case X
Case 1
P1.Range("A1").Value = B1.Range("A1").Value
Case 2
P2.Range("A1").Value = B2.Range("A1").Value
Case 3
P3.Range("A1").Value = B3.Range("A1").Value
Case 4
P4.Range("A1").Value = B4.Range("A1").Value
Case 5
P5.Range("A1").Value = B5.Range("A1").Value
End Select
Next X
End Sub
Welcome any suggestions
Jim

[Kenneth Hobs]

If you use protection, you should not have that problem. You should also protect the vbaproject. Otherwise, I don't see how the user could change the sheet's codename. You could use the index numbers for the worksheets. e.g.
MsgBox WorkSheets(1).Name

[jwilder1]

Thank you for the suggestions. I had already planned on protecting the project, so changing the codenames wasn't an issue. Sometimes my users like to rename the tab names, and some like to personalize the order of sheets, which is why I thought of using codenames. The actual workbook I will be using may have 15 pairs of "B" sheets and "P" sheets, with maybe 10 operations done on each pair, so there is a lot of redundancy.

[Paul_Hossler]

Requires a little work if you add or delete sheets, but might be extended to meet your needs


Option Explicit

Const iMaxSheets As Long = 15

Sub CtCreat()

Dim Ct As Long
Dim X As Long
Dim aWS(1 To iMaxSheets, 1 To 2) As Worksheet


'init array
Set aWS(1, 1) = P1
Set aWS(2, 1) = P2
Set aWS(3, 1) = P3
Set aWS(4, 1) = P4
Set aWS(5, 1) = P5

Set aWS(1, 2) = B1
Set aWS(2, 2) = B2
Set aWS(3, 2) = B3
Set aWS(4, 2) = B4
Set aWS(5, 2) = B5

'Determine number of sheets to work with
Ct = ThisWorkbook.Sheets("Start").Range("B1").Value


'Loop through varable number of sheets
'using Sheet codenames to copy
'B(X) will always copy to P(X)
For X = 1 To Ct
Call DoStuff(aWS(X, 1), aWS(X, 2))
Next X

End Sub

Sub DoStuff(ws1 As Worksheet, ws2 As Worksheet)
ws1.Range("A1").Value = ws2.Range("A1").Value

'more stuff here
End Sub


Paul

[Kenneth Hobs]

Option Explicit
Option Compare Binary
Option Base 1

Sub test()
Dim wsCount As Integer, i As Long, Pidx As Long, Bidx As Long
Dim Ct As Long
Dim ws As Worksheet, PSheet As Worksheet, BSheet As Worksheet
Dim wsCodeNames() As Variant
Dim wsSheetNames() As Variant
wsCount = Worksheets.Count
ReDim wsCodeNames(1 To wsCount)
ReDim wsSheetNames(1 To wsCount)

For i = 1 To wsCount
wsCodeNames(i) = Worksheets(i).CodeName
wsSheetNames(i) = Worksheets(i).Name
Next i
For i = 1 To ThisWorkbook.Sheets("Start").Range("B1").Value
Pidx = index(wsCodeNames(), "P" & i)
Bidx = index(wsCodeNames(), "B" & i)
If Pidx > 0 And Bidx > 0 Then
Set PSheet = Worksheets(wsSheetNames(Pidx))
Set BSheet = Worksheets(wsSheetNames(Bidx))
PSheet.Range("A1").Value = BSheet.Range("A1").Value
End If
Next i
End Sub

'v is not case sensitive
Function index(vArray() As Variant, v As Variant) As Long
On Error GoTo Minus1
index = WorksheetFunction.Match(v, WorksheetFunction.Transpose(vArray), 0)
Exit Function
Minus1:
index = -1
End Function

[jwilder1]

Thanks, guys. Both solutions work great. I will adapt to my real worksheet and test, but I don't forsee any problems. Thanks, again
Jim