Finding Macros

J

John Corbin

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

How do I tell EXCEL to use macros in ThisWorkBook. 3
Modify Recorded Macro 1
difference in macro recording from 2003 to 2007 excel killing me. 2
Adding to exsisting MACRO 2
Run Time error 1004 - Pastespecial method of range class failed. 3
Condense code 2
keep getting the error message - Compile error: Else without If 2
piece of code keeps failing.... 2

Top