How do I tell EXCEL to use macros in ThisWorkBook.

J

John Corbin

I put a workbook together withe several sheets and macrs/VBA Code.

Runs fine on my machine....

I email it out to a few friedns and it does not work on thier
machines.

I had them set macro security to prompt when macros are going to be
run. Still nothing.

After some research, I think the trouble is that EXCEL has to be told
to look in ThisWorklbook first.

How do I do that?

Do I have to adjsut the actual code?

Here is my code:

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
 
M

macropod

Hi John,

If these macros are included in the workbooks you're emailing, there's no reason I can see they shouldn't run just as they do for
you. Having said that, are you sure the macros are included in that workbook and not in another workbook (eg your 'Personal.xls'
workbook)?

As an aside, your code makes a lot of seleections, which are inefficient. Specifying the ranges, without selecting them, is much
more efficient. For example your 'RawFilter' sub could be recoded as:
Sub RawFilter()
Sheets("Working Data").Cells.ClearContents
Sheets("Raw data").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
:=Sheets("Filter Criteria").Rows("1:3"), CopyToRange:=Range("A1"), Unique _
:=False
Sheets("Working Data").Columns.AutoFit
End Sub
Also, your 'FormatWorkingData' sub has a lot of redundant code in it - it looks like someone's recorded a macro to record some
fomatting and changed their mind part way through, so the same range gets formatted with '.HorizontalAlignment = xlGeneral' then
with '.HorizontalAlignment = xlCenter' - only the second routine is needed.


--
Cheers
macropod
[MVP - Microsoft Word]


John Corbin said:
I put a workbook together withe several sheets and macrs/VBA Code.

Runs fine on my machine....

I email it out to a few friedns and it does not work on thier
machines.

I had them set macro security to prompt when macros are going to be
run. Still nothing.

After some research, I think the trouble is that EXCEL has to be told
to look in ThisWorklbook first.

How do I do that?

Do I have to adjsut the actual code?

Here is my code:

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
Click to expand...
 
J

John Corbin

Hi John,

If these macros are included in the workbooks you're emailing, there's noreason I can see they shouldn't run just as they do for
you. Having said that, are you sure the macros are included in that workbook and not in another workbook (eg your 'Personal.xls'
workbook)?

As an aside, your code makes a lot of seleections, which are inefficient.Specifying the ranges, without selecting them, is much
more efficient. For example your 'RawFilter' sub could be recoded as:
Sub RawFilter()
    Sheets("Working Data").Cells.ClearContents
    Sheets("Raw data").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
        :=Sheets("Filter Criteria").Rows("1:3"), CopyToRange:=Range("A1"), Unique _
        :=False
    Sheets("Working Data").Columns.AutoFit
End Sub
Also, your 'FormatWorkingData' sub has a lot of redundant code in it - itlooks like someone's recorded a macro to record some
fomatting and changed their mind part way through, so the same range getsformatted with '.HorizontalAlignment = xlGeneral' then
with '.HorizontalAlignment = xlCenter' - only the second routine is needed.

--
Cheers
macropod
[MVP - Microsoft Word]



John Corbin said:
I put a workbook together withe several sheets and macrs/VBA Code.
Click to expand...
Runs fine on my machine....
Click to expand...
I email it out to a few friedns and it does not work on thier
machines.
Click to expand...
I had them set macro security to prompt when macros are going to be
run.  Still nothing.
Click to expand...
After some research, I think the trouble is that EXCEL has to be told
to look in ThisWorklbook first.
Click to expand...
How do I do that?
Click to expand...
Do I have to adjsut the actual code?
Click to expand...
Here is my code:
Click to expand...
Option Explicit
Sub Main()
Click to expand...
   Call RawFilter
   Call GetScenarioTurns
   Call FormatWorkingData
   Call ProcessData
Click to expand...
End Sub
Click to expand...
Sub RawFilter()
Click to expand...
   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
Click to expand...
End Sub
Click to expand...
Sub GetScenarioTurns()
Click to expand...
   Dim myFormula As String
   Dim wks As Worksheet
   Dim LastRow As Long
Click to expand...
   Set wks = Worksheets("Working Data")
Click to expand...
    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""))"
Click to expand...
   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
Click to expand...
End Sub
Click to expand...
Sub FormatWorkingData()
Click to expand...
   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
Click to expand...
End Sub
Click to expand...
Sub ProcessData()
Click to expand...
   Const TEST_COLUMN As String = "D"
   Dim i As Long, j As Long
   Dim LastRow As Long
   Dim wks As Worksheet
Click to expand...
   Set wks = Worksheets("Working Data")
Click to expand...
   With wks
       Application.ScreenUpdating = False
       Application.Calculation = xlCalculationManual
   End With
Click to expand...
   With ActiveSheet
Click to expand...
       LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
       For i = 2 To LastRow
Click to expand...
           DoSwap i, 3
           For j = 16 To 27 Step 4
Click to expand...
               DoSwap i, j
           Next j
       Next i
Click to expand...
   End With
Click to expand...
   With Application
Click to expand...
       .Calculation =
Click to expand...

...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...

Thanks

In know the macro code looks awkward.. I am in the process of fixing
it... Thansk for
the tips...

on another topic..

Is any of the code I posted a problem for earlier versions of EXCEL?

The above code was composed in EXCEL 2003....
 
M

macropod

Hi John,

I don't see anything there that wouldn't work on Excel 2000 and later (I actually tried it with Excel 2000 and it seemed to work
OK). I suspect the same applies to Excel 97.

--
Cheers
macropod
[MVP - Microsoft Word]


Hi John,

If these macros are included in the workbooks you're emailing, there's no reason I can see they shouldn't run just as they do for
you. Having said that, are you sure the macros are included in that workbook and not in another workbook (eg your 'Personal.xls'
workbook)?

As an aside, your code makes a lot of seleections, which are inefficient. Specifying the ranges, without selecting them, is much
more efficient. For example your 'RawFilter' sub could be recoded as:
Sub RawFilter()
Sheets("Working Data").Cells.ClearContents
Sheets("Raw data").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
:=Sheets("Filter Criteria").Rows("1:3"), CopyToRange:=Range("A1"), Unique _
:=False
Sheets("Working Data").Columns.AutoFit
End Sub
Also, your 'FormatWorkingData' sub has a lot of redundant code in it - it looks like someone's recorded a macro to record some
fomatting and changed their mind part way through, so the same range gets formatted with '.HorizontalAlignment = xlGeneral' then
with '.HorizontalAlignment = xlCenter' - only the second routine is needed.

--
Cheers
macropod
[MVP - Microsoft Word]



John Corbin said:
I put a workbook together withe several sheets and macrs/VBA Code.
Click to expand...
Runs fine on my machine....
Click to expand...
I email it out to a few friedns and it does not work on thier
machines.
Click to expand...
I had them set macro security to prompt when macros are going to be
run. Still nothing.
Click to expand...
After some research, I think the trouble is that EXCEL has to be told
to look in ThisWorklbook first.
Click to expand...
How do I do that?
Click to expand...
Do I have to adjsut the actual code?
Click to expand...
Here is my code:
Click to expand...
Option Explicit
Sub Main()
Click to expand...
Call RawFilter
Call GetScenarioTurns
Call FormatWorkingData
Call ProcessData
Click to expand...
End Sub
Click to expand...
Sub RawFilter()
Click to expand...
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
Click to expand...
End Sub
Click to expand...
Sub GetScenarioTurns()
Click to expand...
Dim myFormula As String
Dim wks As Worksheet
Dim LastRow As Long
Click to expand...
Set wks = Worksheets("Working Data")
Click to expand...
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""))"
Click to expand...
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
Click to expand...
End Sub
Click to expand...
Sub FormatWorkingData()
Click to expand...
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
Click to expand...
End Sub
Click to expand...
Sub ProcessData()
Click to expand...
Const TEST_COLUMN As String = "D"
Dim i As Long, j As Long
Dim LastRow As Long
Dim wks As Worksheet
Click to expand...
Set wks = Worksheets("Working Data")
Click to expand...
With wks
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
End With
Click to expand...
With ActiveSheet
Click to expand...
LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To LastRow
Click to expand...
DoSwap i, 3
For j = 16 To 27 Step 4
Click to expand...
DoSwap i, j
Next j
Next i
Click to expand...
End With
Click to expand...
With Application
Click to expand...
.Calculation =
Click to expand...

...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...

Thanks

In know the macro code looks awkward.. I am in the process of fixing
it... Thansk for
the tips...

on another topic..

Is any of the code I posted a problem for earlier versions of EXCEL?

The above code was composed in EXCEL 2003....
 

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 to get a macro to run on all files in a folder and save each one? 0
Help with VBA to find data delete it change font, add lines then looptill end of file 4
difference in macro recording from 2003 to 2007 excel killing me. 2
Modify Recorded Macro 1
Adding to exsisting MACRO 2
Condense code 2
keep getting the error message - Compile error: Else without If 2
piece of code keeps failing.... 2

Top