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

R

RudeBoy

Active Member
Joined
Feb 2, 2003
Messages
376
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

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
Can anyone help me get my VBA code working? I have spent tons of time but can't quite fix it.
Replies
3
Views
2K
profray
P
A
  • Solved
Sumif not working on my macros but working when i am pressing F8
Replies
3
Views
428
Zot
Z
G
  • Question
Excel VBA Macro steps through ok but when run it causes duplication
Replies
2
Views
3K
Gassy
G
J
  • Solved
Macro Works for Me but Not Others
Replies
3
Views
1K
Fluff
Fluff
F
  • Question
report update - slicing an array into ROWS - any other methods?
Replies
2
Views
495
firatefe
F

Forum statistics

Threads
1,214,585
Messages
6,120,390
Members
448,957
Latest member
Hat4Life

Share this page

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
Back
Top