PC Review Forums Newsgroups Microsoft Excel Microsoft Excel Discussion Finding Macros

Reply

Finding Macros

 
Thread Tools Rate Thread
Old 09-07-2008, 02:01 AM   #1
John Corbin
Guest
 
Posts: n/a
Default Finding Macros


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
  Reply With Quote
Reply



Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off