Excel Excel Macro Help

Macro120283 · Apr 13, 2010

Hi All

Just started using Macros last week, so not an expert but can understand the very basics. I have written the following code below, and it works except for when it gets to th bits highlighted in red. It then asks for an update on values but I can't understand this.

Thanks in advance for any help!!

ActiveWindow.SmallScroll Down:=-21
Sheets("Sheet2").Select
ActiveWindow.SmallScroll Down:=-31
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Range("R1").Value, Destination:=Range _
("$A$1"))
.Name = "MItest1204"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "~"
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "House Prem"
Columns("A:C").Select
Selection.Copy
Sheets("Sheet3").Select
ActiveWindow.SmallScroll Down:=-24
Columns("A:A").Select
ActiveSheet.Paste
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "House Pol"
Sheets("House Prem").Select
ActiveWindow.SmallScroll Down:=-30
Range("C11").Select
ActiveWindow.SmallScroll Down:=-29
Range("A1:C2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("House Prem").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("House Prem").Sort.SortFields.Add Key:=Range("A2:A8500" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("House Prem").Sort.SortFields.Add Key:=Range("C2:C8500" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("House Prem").Sort
.SetRange Range("A1:C8500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Sheets("House Pol").Select
ActiveWorkbook.Worksheets("House Pol").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("House Pol").Sort.SortFields.Add Key:=Range("A2:A8500" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("House Pol").Sort.SortFields.Add Key:=Range("C2:C8500") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("House Pol").Sort
.SetRange Range("A1:C8500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(1), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Sheets("Sheet4").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Premium"
Range("A2").Select
ActiveCell.FormulaR1C1 = "ha total"
Range("A3").Select
ActiveCell.FormulaR1C1 = "hb total"
Range("A4").Select
ActiveCell.FormulaR1C1 = "hc total"
Range("A5").Select
ActiveCell.FormulaR1C1 = "hh total"
Range("A8").Select
ActiveCell.FormulaR1C1 = "rb total"
Range("A11").Select
ActiveCell.FormulaR1C1 = "ca total"
Range("A12").Select
ActiveCell.FormulaR1C1 = "ms total"
Range("A13").Select
ActiveCell.FormulaR1C1 = "tv total"
Range("A17").Select
ActiveCell.FormulaR1C1 = "Policy"
Range("A18").Select
ActiveCell.FormulaR1C1 = "ha count"
Range("A19").Select
ActiveCell.FormulaR1C1 = "hb count"
Range("A20").Select
ActiveCell.FormulaR1C1 = "hc count"
Range("A21").Select
ActiveCell.FormulaR1C1 = "hh count"
Range("A24").Select
ActiveCell.FormulaR1C1 = "rb count"
Range("A27").Select
ActiveCell.FormulaR1C1 = "ca count"
Range("A28").Select
ActiveCell.FormulaR1C1 = "ms count"
Range("A29").Select
ActiveCell.FormulaR1C1 = "tv count"
Range("A31").Select
ActiveWindow.SmallScroll Down:=-26
Range("A1").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Range("A17").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-1],House Prem!R[-1]C[-1]:R[2498]C[1],2,FALSE)),"""",VLOOKUP(RC[-1],House Prem!R[-1]C[-1]:R[2498]C[1],2,FALSE))"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B13"), Type:=xlFillDefault
Range("B2:B13").Select
Range("B6").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
Range("B14").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("B6").Select
Selection.Font.Bold = True
Range("B8").Select
Selection.Font.Bold = True
Range("B14").Select
Selection.Font.Bold = True
Range("B6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.NumberFormat = "$#,##0.00"
Range("B6").Select
Selection.Copy
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("D14").Select
ActiveWindow.SmallScroll Down:=5
Range("B18").Select
ActiveWindow.SmallScroll Down:=-24
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-1],House Pol!R[-17]C[-1]:R[2482]C[2],2,FALSE)),"""",VLOOKUP(RC[-1],House Pol!R[-17]C[-1]:R[2482]C[2],2,FALSE))"
Range("B18").Select
Selection.AutoFill Destination:=Range("B18:B29"), Type:=xlFillDefault
Range("B18:B29").Select
ActiveWindow.SmallScroll Down:=-12
Range("B22").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
Range("B30").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Range("B30").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.Bold = True
Selection.Copy
Range("B24").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Range("B22").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=-16
Range("B14").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Range("B15").Select
ActiveWindow.SmallScroll Down:=7
Range("B30").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Range("D28").Select
ActiveWindow.SmallScroll Down:=-52
Range("E3").Select
ActiveCell.FormulaR1C1 = "Home"
Range("E5").Select
ActiveCell.FormulaR1C1 = "Residential"
Range("E7").Select
ActiveCell.FormulaR1C1 = "Misc"
Range("F7").Select
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").ColumnWidth = 4
Range("G2").Select
ActiveCell.FormulaR1C1 = "Invited"
Range("G2").Select
ActiveCell.FormulaR1C1 = "No Invited"
Range("I2").Select
ActiveCell.FormulaR1C1 = "Premium"
Columns("G:G").Select
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").ColumnWidth = 2.71
Range("K9").Select
Columns("F:F").ColumnWidth = 3
Range("H7").Select
Columns("H:H").ColumnWidth = 3
Range("G3").Select
ActiveWindow.SmallScroll Down:=-16
ActiveCell.FormulaR1C1 = "=R[19]C[-5]"
Range("G5").Select
ActiveCell.FormulaR1C1 = "=R[19]C[-5]"
Range("G7").Select
ActiveCell.FormulaR1C1 = "=R[23]C[-5]"
Range("G8").Select
ActiveWindow.SmallScroll Down:=-13
Range("I3").Select
ActiveCell.FormulaR1C1 = "=R[3]C[-7]"
Range("I5").Select
ActiveCell.FormulaR1C1 = "=R[3]C[-7]"
Range("I7").Select
ActiveCell.FormulaR1C1 = "=R[7]C[-7]"
Range("G8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)"
Range("I8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)"
Range("E8").Select
ActiveCell.FormulaR1C1 = "Sub Total"
Range("E8:I8").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.Bold = True
Range("K5").Select
ActiveWindow.SmallScroll Down:=-14
Range("F2:I7").Select
Range("E2:I7").Select
Range("K7").Select
ActiveWindow.SmallScroll Down:=-18
Columns("A:C").Select
Range("C1").Activate
Selection.EntireColumn.Hidden = True
Range("K13").Select
ActiveWindow.SmallScroll Down:=-68
Sheets("Sheet4").Select
ActiveWindow.SmallScroll Down:=-70
Columns("I:I").EntireColumn.AutoFit
End Sub

Macro120283 · Apr 14, 2010

No bother, I've found the answer.

aliram85 · Mar 21, 2011

hey all, i am trying to create a macro which samples data and then translates it into a graph format. The problem is i always get a message saying "sampling-output range will overwrite existing data press ok to overwrite data in ranges...........".If i press ok it starts doing things that it shouldn't do and if i press cancel it doesn't do anything. PLEASE HELP!!!!!!!!!!!!!!!!!!!!

heres the code:
Opens Prompt to Select Force File (these are the *.anc files)
sFilename = Application.GetOpenFilename("All files (*.*), *.*")
If sFilename = False Then Exit Sub
With Application.Dialogs(xlDialogOpen)
.Show
End With

'Copies Data from Force File (Filter First. Must also ensure that the time stamps of force and position data agree)
Range("A6:G8010").Select
Selection.Copy
Windows("Erin trial 3 final.xls").Activate
Sheets("Data").Select
Range("A6:G6").Select
Sheets("data").Paste
Range("H6:M6").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("H6:M8010")
Range("H6:M8010").Select
Range("P6").Select

'Samples force data every 10 and enteres in ROS worksheet
AddIns("analysis toolpak").Installed = True
Application.Run "ATPVBAEN.XLAM!Sample", Worksheets("Data").Range("$J$6:$J$12000"), Worksheets("ROS").Range("$B$43:$B$12000"), "P", 20, False
Application.Run "ATPVBAEN.XLAM!Sample", Worksheets("Data").Range("$K$6:$K$12000"), Worksheets("ROS").Range("$C$43:$C$12000"), "P", 20, False
End Sub
Sub EnterPosition()
'
' EnterPosition Macro
' Macro recorded 2/8/2007 by meaganvaughan
'
' Keyboard Shortcut: Ctrl+p
'
'Opens Prompt to Select Position File (these are the *.trc files)
sFilename = Application.GetOpenFilename("All files (*.*), *.*")
If sFilename = False Then Exit Sub
With Application.Dialogs(xlDialogOpen)
.Show
End With

'Copies data from position file (Must ensure that the time stamps of force and position data agree)
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Range("D6:G805").Select
Selection.Copy

'Pastes data to calculation file
Windows("Erin trial 3 final.xls").Activate
Sheets("ROS").Select
Range("D43:G43").Select
Sheets("ROS").Paste

'Autofills the columns
Range("H43").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("H43:H641")
Range("H43:H641").Select
Range("J43

43").Select
Selection.AutoFill Destination:=Range("J43

641")
Range("J43

641").Select
Range("Q43").Select
Selection.AutoFill Destination:=Range("Q43:Q641")
Range("Q43:Q641").Select
Range("Q43").Select

'SavesAs prompt
With Application.Dialogs(xlDialogSaveAs)
.Show
End With
End Sub

Excel Excel Macro Help

Macro120283

Macro120283

aliram85