Consulting

Results 1 to 6 of 6

Thread: Use variable with Sheet Codenames

  1. #1
    VBAX Regular
    Joined
    Jul 2005
    Posts
    30
    Location

    Use variable with Sheet Codenames

    TestLoop.xlsmI 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.
    [VBA]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[/VBA]
    Welcome any suggestions
    Jim

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,911
    Location
    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.
    [VBA]MsgBox WorkSheets(1).Name[/VBA]

  3. #3
    VBAX Regular
    Joined
    Jul 2005
    Posts
    30
    Location
    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.

  4. #4
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,275
    Location
    Requires a little work if you add or delete sheets, but might be extended to meet your needs

    [vba]
    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
    [/vba]

    Paul

  5. #5
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,911
    Location
    [vba]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
    [/vba]

  6. #6
    VBAX Regular
    Joined
    Jul 2005
    Posts
    30
    Location

    Solved

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •