PC Review
Forums
Newsgroups
Microsoft Excel
Microsoft Excel Discussion
Finding Macros
Forums
Newsgroups
Microsoft Excel
Microsoft Excel Discussion
Finding Macros
![]() |
Finding Macros |
|
|
Thread Tools | Rate Thread |
|
|
#1 |
|
Guest
Posts: n/a
|
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 |
|
![]() |
|
| Thread Tools | |
| Rate This Thread | |
|
|

Main Page 

