Welcome to the { mindfrost82.com } forums.

You are currently viewing our boards as a guest which gives you limited access to view most discussions and access our other features. By joining our free community you will have access to post topics, communicate privately with other members (PM), respond to polls, upload content and access many other special features. Registration is fast, simple and absolutely free so please, join our community today!

If you have any problems with the registration process or your account login, please contact contact us.

Go Back   { mindfrost82.com } > Gadget Corner > Tech Newsgroups > Microsoft > MS Office > Excel

Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old 07-09-2008, 01:01 AM
John Corbin
 
Posts: n/a
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

  { mindfrost82.com } > Gadget Corner > Tech Newsgroups > Microsoft > MS Office > Excel


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

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 Off
[IMG] code is Off
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On



All times are GMT. The time now is 03:55 AM.


Powered by vBulletin, Copyright ©2000 - 2008, Jelsoft Enterprises Ltd.
Search Engine Friendly URLs by vBSEO 3.1.0 ©2007, Crawlability, Inc.
© 1999-2008 mindfrost82.com v11.0


Sponsors:
Remortgages | Credit Cards | Duwayne Burnside | Loans | Per Insurance



1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114