When I run my Macro other Worksheets that are not the target seem to move items around? Does anyone know why that is?

RudeBoy

Active Member
Joined
Feb 2, 2003
Messages
364
When I run my Macro - Other sheets that pull from my Macro sheets targeted seem to move column around etc.?
The only work around I have tried is to comment out my Formulas in the other sheets that move around by changing =IF to #IF until after I run my macro.

Is there away to lock other work sheets that are not being used?

Her is my Macro:
VBA Code:
Sub SpinDblsNEW()
'
' SpinDbls Macro
' Macro recorded 3/13/2003 CBS
'
' Clear out previous entries sheet
    Sheets("Women's Doubles").Select
    Sheets("Women's Doubles").EnableCalculation = False
    Range("A9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Resize(, 5).Select
    Selection.ClearContents
    Range("G9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Resize(, 5).Select
    Selection.ClearContents
    Range("M9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Resize(, 1).Select
    Selection.ClearContents
    Sheets("Men's Doubles").Select
    Sheets("Men's Doubles").EnableCalculation = False
    Range("A9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Resize(, 5).Select
    Selection.ClearContents
    Range("G9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Resize(, 5).Select
    Selection.ClearContents
    Range("M9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Resize(, 1).Select
    Selection.ClearContents
    Sheets("Mixed Doubles").Select
    Sheets("Mixed Doubles").EnableCalculation = False
    Range("A9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Resize(, 5).Select
    Selection.ClearContents
    Range("G9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Resize(, 5).Select
    Selection.ClearContents
'
' Sort the I/P worksheet by gender to set up counts.
    Sheets("MixD_wrk").Select
    Cells.Select
    Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("D2") _
        , Order2:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom
' Delete the Dummy Bowlers
    Range("E2").Activate
    Do While Not IsEmpty(ActiveCell)
        If (ActiveCell = "FU" Or ActiveCell = "MU") Then
            ActiveCell.EntireRow.Delete
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
' Count the women
    Fcount = 0
    Mcount = 0
    rowcnt = 2
    Range("E2").Activate
    Do While (ActiveCell = "F" Or ActiveCell = "F1")
        Fcount = Fcount + 1
        rowcnt = rowcnt + 1
        Cells.Item(rowcnt, 5).Activate
    Loop
' Count the men
    Do While ActiveCell = "M"
        Mcount = Mcount + 1
        rowcnt = rowcnt + 1
        Cells.Item(rowcnt, 5).Activate
    Loop
' Format section optional

'    Range(Cells.Item(2, 2), Cells.Item(Fcount + 1, 3)).Select
'    With Selection.Font
'        .Name = "Arial"
'        .FontStyle = "Bold"
'        .Size = 10
'        .ColorIndex = 7
'    End With
'    Range(Cells.Item(Fcount + 2, 2), Cells.Item(rowcnt + 1, 3)).Select
'   With Selection.Font
'        .Name = "Arial"
'        .FontStyle = "Bold"
'        .Size = 10
'        .ColorIndex = 32
'    End With
'    Range(Cells.Item(2, 4), Cells.Item(rowcnt - 1, 4)).Select
'    With Selection.Font
'        .Name = "Georgia"
'        .FontStyle = "Bold"
'        .Size = 10
'        .ColorIndex = 0
'    End With
'    With Selection.Interior
'        .ColorIndex = 27
'        .Pattern = xlSolid
'    End With
'
' Populate the "Women's Doubles" sheet
    Range(Cells.Item(2, 1), Cells.Item(Fcount + 1, 5)).Select
    Selection.Copy
    Sheets("Women's Doubles").Select
    Range("G9").Select
    Selection.PasteSpecial Paste:=xlValues
    Range("A1").Select
    Sheets("MixD_wrk").Select
'
' Populate the mixed doubles sheet
' Select the range of men and copy range set once for each woman entrant.
    Range(Cells.Item(Fcount + 2, 1), Cells.Item(rowcnt - 1, 5)).Select
    Selection.Copy
    Sheets("Mixed Doubles").Select
    Sheets("Mixed Doubles").EnableCalculation = False
    Range("G9").Select
    For y = 1 To Fcount
        Selection.PasteSpecial Paste:=xlValues
'        Selection.PasteSpecial Paste:=xlFormats
        Range("G9").Select
        ActiveCell.Offset(y * Mcount, 0).Select
    Next y
    Sheets("Mixed Doubles").EnableCalculation = True
'
' Populate the "Men's Doubles" sheet
    Sheets("Men's Doubles").Select
    Range("G9").Select
    Selection.PasteSpecial Paste:=xlValues
    Range("A1").Select
    rowcnt = 2
    Sheets("MixD_wrk").Activate
   
' Select and copy data for each woman entrant, match "M" range and paste.
    For x = 1 To Fcount
        Cells.Item(rowcnt, 1).Activate
        ActiveCell.Offset(0, 0).Range("A1:E1").Select
        Selection.Copy
        Sheets("Mixed Doubles").Activate
        Sheets("Mixed Doubles").EnableCalculation = False
        Range("a9").Select
        ActiveCell.Offset((Mcount * (x - 1)), 0).Range(Cells.Item(1, 1), _
            Cells.Item(Mcount, 5)).Select
        Selection.PasteSpecial Paste:=xlValues
'        Selection.PasteSpecial Paste:=xlFormats
        Sheets("MixD_wrk").Activate
        rowcnt = rowcnt + 1
    Next x
' Sort "Mixed Doubles" sheet by high score
    Range("A1").Select
    Sheets("Mixed Doubles").Select
    Sheets("Mixed Doubles").EnableCalculation = True
    Range("A9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Sort Key1:=Range("M9"), Order1:=xlDescending, Key2:=Range("C9") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
    Range("A1").Select
'
' Populate the men doubles sheet
' Select the range of men and copy range set once for each woman entrant.
    rowcnt = 9
    Sheets("Men's Doubles").Select
    Sheets("Men's Doubles").EnableCalculation = False
    For x = 1 To Mcount - 1
        Cells.Item(9, 7).Activate
        ActiveCell.Offset(x - 1, 0).Range("A1:E1").Select
        With Selection
            .Copy Destination:=Range(Cells.Item(rowcnt, 1), _
            Cells.Item((Mcount - 1) - x + rowcnt, 5))
        End With
        If (Mcount - (x + 1) = 0) Then Exit For
        ActiveCell.Offset(2, 0).Range(Cells.Item(1, 1), _
            Cells.Item(Mcount - (x + 1), 5)).Select
        rowcnt = rowcnt + (Mcount - x)
        With Selection
            .Copy Destination:=Range(Cells.Item(rowcnt + 1, 7), _
            Cells.Item(Mcount - (x + 1) + rowcnt, 11))
        End With
    Next x
    Sheets("Men's Doubles").EnableCalculation = True
    Cells.Item(9, 7).Activate
    ActiveCell.Offset(0, 0).Range("A1:F1").Select
    Selection.Delete Shift:=xlUp
    Cells.Item(9, 13).Activate
    ActiveCell.FormulaR1C1 = "=SUM(RC[-9],RC[-3])"
    Selection.AutoFill Destination:=Range(Cells.Item(9, 13), _
            Cells.Item(rowcnt, 13)), Type:=xlFillValues
' Sort "Men's Doubles" sheet by high score
    Range("A9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Sort Key1:=Range("M9"), Order1:=xlDescending, Key2:=Range("C9") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
    Range("A1").Select
'
'
' Populate the Women's doubles sheet
' Select the range of men and copy range set once for each woman entrant.
    rowcnt = 9
    Sheets("Women's Doubles").Select
    Sheets("Women's Doubles").EnableCalculation = False
    For x = 1 To Fcount - 1
        Cells.Item(9, 7).Activate
        ActiveCell.Offset(x - 1, 0).Range("A1:E1").Select
        With Selection
            .Copy Destination:=Range(Cells.Item(rowcnt, 1), _
            Cells.Item((Fcount - 1) - x + rowcnt, 5))
        End With
        If (Fcount - (x + 1) = 0) Then Exit For
        ActiveCell.Offset(2, 0).Range(Cells.Item(1, 1), _
            Cells.Item(Fcount - (x + 1), 5)).Select
        rowcnt = rowcnt + (Fcount - x)
        With Selection
            .Copy Destination:=Range(Cells.Item(rowcnt + 1, 7), _
            Cells.Item(Fcount - (x + 1) + rowcnt, 11))
        End With
    Next x
    Sheets("Women's Doubles").EnableCalculation = True
    Cells.Item(9, 7).Activate
    ActiveCell.Offset(0, 0).Range("A1:F1").Select
    Selection.Delete Shift:=xlUp
    Cells.Item(9, 13).Activate
    ActiveCell.FormulaR1C1 = "=SUM(RC[-9],RC[-3])"
    Cells.Item(9, 13).Select
    Selection.AutoFill Destination:=Range(Cells.Item(9, 13), _
            Cells.Item(rowcnt, 13)), Type:=xlFillValues
   
' Sort "Women's Doubles" sheet by high score
    Range("A9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Sort Key1:=Range("M9"), Order1:=xlDescending, Key2:=Range("C9") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
    Range("A1").Select
End Sub
 
Last edited by a moderator:

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
13,790
Office Version
  1. 365
Platform
  1. Windows
The sheets are not being changed, the formulas are being recalculated to reflect the changes that the code has made to the data source. That is what is meant to happen.
 

Forum statistics

Threads
1,143,687
Messages
5,720,301
Members
422,275
Latest member
Maria95

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top