Tried posting this earlier but..
I have a workbook taht comtains macros/vba code.
Worlks great on my pc but not pn othre peoples PC's.
Macro security is set to moderate.
How can I get the macros/code to work on other pc's?
Option Explicit
Sub Main()
Call RawFilter
Call GetScenarioTurns
Call FormatWorkingData
Call ProcessData
End Sub
Sub RawFilter()
Sheets("Working Data").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("Raw data").Cells.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange _
:=Sheets("Filter Criteria").Rows("1:3"),
CopyToRange:=Range("A1"), Unique _
:=False
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
End Sub
Sub GetScenarioTurns()
Dim myFormula As String
Dim wks As Worksheet
Dim LastRow As Long
Set wks = Worksheets("Working Data")
myFormula = "=IF(ISERR(-TRIM(RIGHT(SUBSTITUTE(H2,""/""," _
& "REPT("" "",100)),100))),""UNKNOWN""," _
& "IF(and(--TRIM(RIGHT(SUBSTITUTE(H2,""/""," _
& "REPT("" "",100)),100))>=35," _
& "--TRIM(RIGHT(SUBSTITUTE(H2,""/""," _
& "REPT("" "",100)),100))<=1859)," _
& "VALUE(TRIM(RIGHT(SUBSTITUTE(H2,""/""," _
& "REPT("" "",100)),100))),""UNKNOWN""))"
With wks
.Range("i1").EntireColumn.Insert
LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Range("i2:i" & LastRow).Formula = myFormula
.Range("G2:G" & LastRow).Replace "TS", "Battleground"
.Range("Q2:AH" & LastRow).Replace ". dummy3 dummy3, ././., ",
""
.Range("Q2:AH" & LastRow).Replace ". . ., ././., .", ""
End With
End Sub
Sub FormatWorkingData()
Application.ScreenUpdating = False
Cells.Select
Selection.RowHeight = 25
Rows("1:1").Select
Selection.RowHeight = 40
With Selection.Font
.Name = "Bookman Old Style"
.FontStyle = "Regular"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Cells.Select
With Selection.Font
.Name = "Bookman Old Style"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Range("A1:AH1").Select
With Selection.Interior
.ColorIndex = 43
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Cells.Select
Selection.Columns.AutoFit
Columns("A:A").Select
Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
ActiveWindow.SmallScroll ToRight:=8
Columns("K:K").Select
Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
Columns("L:L").Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("I:I").Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("J:J").Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("M:N").Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
Selection.NumberFormat = "ddmmmyy"
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("C:C").Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("E:E").Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Application.ScreenUpdating = True
Range("I1") = "Length"
Columns("I:I").Select
Selection.Columns.AutoFit
End Sub
Sub ProcessData()
Const TEST_COLUMN As String = "D"
Dim i As Long, j As Long
Dim LastRow As Long
Dim wks As Worksheet
Set wks = Worksheets("Working Data")
With wks
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
End With
With ActiveSheet
LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To LastRow
DoSwap i, 3
For j = 16 To 27 Step 4
DoSwap i, j
Next j
Next i
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Private Sub DoSwap(ActiveRow As Long, ActiveCol As Long)
Dim tmp As Variant
With ActiveSheet.Cells(ActiveRow, ActiveCol)
If .Offset(0, 1).Value Like "*AoS" Then
tmp = .Offset(0, 1).Value
.Offset(0, 1).Value = .Offset(0, 3).Value
.Offset(0, 3).Value = tmp
tmp = .Value
.Value = .Offset(0, 2).Value
.Offset(0, 2).Value = tmp
End If
End With
End Sub
Similar Threads
