Runtime Error 2147417848(80010108) Method Autofill of Object Range failed

S

seejay

New Member
Joined
Jul 9, 2014
Messages
1
Hi,
I keep getting this error when I run my macros. It works fine the first time I run it, but if I run it again it gives me this error. My code is pasted below....its very long I hope you can make sense of it. I tried to fix the problem using the function clearclipboard but it didn't work....thought maybe it was a memory issue.
I've tried everything from activate command, option explicit, qualifying the unqualified. I've highlighted the line at which the error occurs. I'm basically just trying to add a column to a table on thr Sheet("3g Traffic") . Your help is greatly appreciated.
Code: 
#If VBA7 Then
   Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As LongPtr
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
    
#End If




Public Function ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Function



Sub avail3G()
'
' avail3G Macro
'


'




Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs "3G Availability.xlsx"


ActiveSheet.Select
ActiveSheet.Name = "3G Availability"


    Rows("1:5").Select
    Selection.Delete Shift:=xlUp
    Columns("A:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:J").Select
    Selection.Delete Shift:=xlToLeft
    
     Range("A1:G1").Select
    Selection.AutoFilter
    
    Range("A1").CurrentRegion.Select
    ActiveSheet.Range("A1").AutoFilter Field:=3, Criteria1:="=555*"
    Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    
    Range("A1").CurrentRegion.Select
    ActiveSheet.Range("A1").AutoFilter Field:=3, Criteria1:="=444*"
    Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    
    Range("A1").CurrentRegion.Select
    ActiveSheet.Range("A1").AutoFilter Field:=3, Criteria1:="=777*"
    Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    ActiveSheet.Range("A1").AutoFilter Field:=3
    
    Range("A1").CurrentRegion.Select
    ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="=555*"
    Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    
    Range("A1").CurrentRegion.Select
    ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="=444*"
    Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    
    Range("A1").CurrentRegion.Select
    ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="=777*"
    Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    ActiveSheet.Range("A1").AutoFilter Field:=1
    
Dim Avail As Range
Dim AV As Long
Set Avail = Rows(1).Find(What:="Service time of Cell(sec)", LookIn:=xlValues, LookAt:=xlWhole)
AV = Cells(Rows.Count, Avail.Column).End(xlUp).Row
Avail.Offset(, 1).EntireColumn.Insert
Cells(1, Avail.Column + 1).Value = "Availability(%)"
Range(Cells(2, Avail.Column + 1), Cells(AV, Avail.Column + 1)).Formula = "=F2/604800"
Range(Cells(2, Avail.Column + 1), Cells(AV, Avail.Column + 1)).NumberFormat = ("0.00%")
   
    
Dim Found As Range
Dim LR As Long
Set Found = Rows(1).Find(What:="NodeB Name", LookIn:=xlValues, LookAt:=xlWhole)
LR = Cells(Rows.Count, Found.Column).End(xlUp).Row
Found.Offset(, 1).EntireColumn.Insert
Cells(1, Found.Column + 1).Value = "Name"
Range(Cells(2, Found.Column + 1), Cells(LR, Found.Column + 1)).Formula = "=LEFT(A2,5)"






Dim Find As Range
Dim LRow As Long
Set Find = Rows(1).Find(What:="Cell Name", LookIn:=xlValues, LookAt:=xlWhole)
LRow = Cells(Rows.Count, Find.Column).End(xlUp).Row
Find.Offset(, 1).EntireColumn.Insert
Cells(1, Find.Column + 1).Value = "Cells"
Range(Cells(2, Find.Column + 1), Cells(LRow, Find.Column + 1)).Formula = "=LEFT(D2,15)"




Dim directory As String
Dim Filename As String




 directory = "C:\Users\caroline.johnson.ECONETZW\Desktop\Econet Docs\NOC Operations Support\Availability\"
 Filename = "Econet Wireless-3G_Cell AvailabilityTraffic_Report Week17.xlsx"
  Workbooks.Open (directory & Filename)
  
    Windows("Econet Wireless-3G_Cell AvailabilityTraffic_Report Week17.xlsx").Activate
    Sheets("hre").Select
    Sheets("hre").Copy Before:=Workbooks("3G Availability.xlsx").Sheets(1)
    Windows("Econet Wireless-3G_Cell AvailabilityTraffic_Report Week17.xlsx").Activate
    Sheets("northern").Select
    Sheets("northern").Copy Before:=Workbooks("3G Availability.xlsx").Sheets(2)
    Windows("Econet Wireless-3G_Cell AvailabilityTraffic_Report Week17.xlsx").Activate
    Sheets("All site codes").Select
    Sheets("All site codes").Copy Before:=Workbooks("3G Availability.xlsx").Sheets(3)
    Windows("Econet Wireless-3G_Cell AvailabilityTraffic_Report Week17.xlsx").Activate
    Sheets("Site codes").Select
    Sheets("Site codes").Copy Before:=Workbooks("3G Availability.xlsx").Sheets(4)
    Windows("Econet Wireless-3G_Cell AvailabilityTraffic_Report Week17.xlsx").Activate
    Sheets("CHARTS").Select
    Sheets("CHARTS").Copy Before:=Workbooks("3G Availability.xlsx").Sheets(5)
    Windows("Econet Wireless-3G_Cell AvailabilityTraffic_Report Week17.xlsx").Activate
    Sheets("3G Traffic").Select
    Sheets("3G Traffic").Copy Before:=Workbooks("3G Availability.xlsx").Sheets(6)
    Windows("Econet Wireless-3G_Cell AvailabilityTraffic_Report Week17.xlsx").Activate
    Sheets("Summary").Select
    Sheets("Summary").Copy Before:=Workbooks("3G Availability.xlsx").Sheets(7)
   Windows("Econet Wireless-3G_Cell AvailabilityTraffic_Report Week17.xlsx").Activate
   ActiveWorkbook.Close savechanges:=False
     




Sheets("3G Availability").Select
Dim LastRow As Long
LastRow = Cells(Rows.Count, "E").End(xlUp).Row
Range(Cells(2, "F"), Cells(LastRow, "F")).Formula = "=VLOOKUP(E2,'Site codes'!A:H,8,0)"






    
    Sheets("3G Availability").Select
    Range("A1").CurrentRegion.Select
        ActiveSheet.Range("B1").AutoFilter Field:=2, Criteria1:=Array( _
        "BYO00", "BYO01", "BYO08", _
        "BYO10", "MAT00", "MAT01", "MAT02"), Operator:=xlFilterValues
    Cells.Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet8").Select
    Sheets("Sheet8").Name = "byo&mat"
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("G1"), SortOn _
        :=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1").CurrentRegion
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("J3") = "count"
    Range("J4") = "average"
    Range("J5") = "total traffic"
    Range("J6") = "low 10%"
    Range("J7") = "low 25%"
    Range("J8") = "upper 25%"
    
    'Count Value
    Dim rngRange As Range
    Dim no As Long
    Set rngRange = Range("A2").CurrentRegion
    no = rngRange.Rows.Count
    Range("K3") = no
    
    'Average
    Dim myLastRowb As Long
    
    myLastRowb = Cells(Rows.Count, "E").End(xlUp).Row
    
    Dim rng As Range
    
    Set rng = Range(Cells(2, "H"), Cells(myLastRowb, "H"))
    
    ave = WorksheetFunction.Average(rng)
   
    Range("K4") = ave
    Range("K4").NumberFormat = "0.00%"
    
    'Total Traffic
    
    Dim rng1 As Range
    Set rng1 = Range(Cells(2, "I"), Cells(myLastRowb, "I"))
    tot = WorksheetFunction.Sum(rng1)
    Range("K5") = tot
    
    'Low 10%
    Dim lowten As Long
    Dim rng2 As Range
    
    lowten = myLastRowb - (myLastRowb * 0.1)
    Set rng2 = Range(Cells(myLastRowb, "H"), Cells(lowten, "H"))
    worst = WorksheetFunction.Average(rng2)
    Range("K6") = worst
    Range("K6").NumberFormat = "0.00%"
    
    'Low25%
    Dim lowqrt As Long
    Dim rng3 As Range
    
    lowqrt = myLastRowb - (myLastRowb * 0.25)
    Set rng3 = Range(Cells(myLastRowb, "H"), Cells(lowqrt, "H"))
    worstqtr = WorksheetFunction.Average(rng3)
    Range("K7") = worstqtr
    Range("K7").NumberFormat = "0.00%"
    
    'Upper 25%
    Dim upqrt As Long
    Dim rng4 As Range
    
    upqrt = myLastRowb * 0.25
    Set rng4 = Range(Cells(2, "H"), Cells(upqrt, "H"))
    upper = WorksheetFunction.Average(rng4)
    Range("K8") = upper
    Range("K8").NumberFormat = "0.00%"
    
    
    
    
    
    Sheets("3G Availability").Select
    Range("A1").CurrentRegion.Select
        ActiveSheet.Range("B1").AutoFilter Field:=2, Criteria1:=Array( _
        "Bikit", "Great", "Gutu(", _
        "Jerer", "Majan", "Masha", "Masvi", "MID00", "MID01", "MID10", _
        "Morge", "Muche", "MVO00", "MVO01", "MVO10", "Nyika", _
        "Renco", "Rujek", "Sisk", "Zimba"), Operator:=xlFilterValues
    Cells.Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet9").Select
    Sheets("Sheet9").Name = "south"
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("G1"), SortOn _
        :=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1").CurrentRegion
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
   Range("J3") = "count"
    Range("J4") = "average"
    Range("J5") = "total traffic"
    Range("J6") = "low 10%"
    Range("J7") = "low 25%"
    Range("J8") = "upper 25%"
    
    'Count Value
    Dim rngsouth As Range
    Set rngsouth = Sheets("south").Range("H2").CurrentRegion
    no = rngsouth.Rows.Count
    Range("K3") = no
    


    
    
    
    'Average
    Dim myLastRows As Long
    'myLastRows is count
    myLastRows = Sheets("south").Range("F2").CurrentRegion.Rows.Count
    Range("M10") = myLastRows
    Dim rngs1 As Range
    Set rngs1 = Sheets("south").Range(Sheets("south").Cells(2, "H"), Sheets("south").Cells(myLastRows, "H"))
    ave = WorksheetFunction.Average(rngs1)
    Range("K4") = ave
    Range("K4").NumberFormat = "0.00%"
    
    'Total Traffic
    Dim rngs2 As Range
    Set rngs2 = Sheets("south").Range(Sheets("south").Cells(2, "I"), Sheets("south").Cells(myLastRows, "I"))
    tot = WorksheetFunction.Sum(rngs2)
    Range("K5") = tot
    
    'Low 10%
    Dim rngs3 As Range
    lowten = myLastRows - (myLastRows * 0.1)
    Set rngs3 = Sheets("south").Range(Sheets("south").Cells(myLastRows, "H"), Sheets("south").Cells(lowten, "H"))
    
    worst = WorksheetFunction.Average(rngs3)
    Range("K6") = worst
    Range("K6").NumberFormat = "0.00%"
    
    
    
    
    'Low25%
    Dim rngs4 As Range
    lowqrt = myLastRows - (myLastRows * 0.25)
    Set rngs4 = Sheets("south").Range(Sheets("south").Cells(myLastRows, "H"), Sheets("south").Cells(lowqrt, "h"))
    worstqtr = WorksheetFunction.Average(rngs4)
    Range("K7") = worstqtr
    Range("K7").NumberFormat = "0.00%"
    
    'Upper 25%
    Dim rngs5 As Range
    upqrt = myLastRows * 0.25
    Set rngs5 = Sheets("south").Range(Sheets("south").Cells(2, "H"), Sheets("south").Cells(upqrt, "H"))
    upper = WorksheetFunction.Average(rngs5)
    Range("K8") = upper
    Range("K8").NumberFormat = "0.00%"
    
    
    
   Sheets("3G Availability").Select
    Range("A1").CurrentRegion.Select
        ActiveSheet.Range("B1").AutoFilter Field:=2, Criteria1:=Array( _
        "Bindu", "Cente", "Chipa", _
        "Chiwa", "Conce", "Dombo", "Glend", "MAN00", "MAN01", "MAN10", _
        "Human", "Jumbo", "MSH00", "MSH01", "MSH02", "Mazow", _
        "Mount", "Mvurw", "Rushi", "Shamv", "Troja"), Operator:=xlFilterValues
    Cells.Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet10").Select
    Sheets("Sheet10").Name = "north"
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("G1"), SortOn _
        :=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1").CurrentRegion
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    Range("J3") = "count"
    Range("J4") = "average"
    Range("J5") = "total traffic"
    Range("J6") = "low 10%"
    Range("J7") = "low 25%"
    Range("J8") = "upper 25%"
    
    'Count Value
    Dim rngnorth As Range
    Set rngnorth = Sheets("north").Range("F2").CurrentRegion
    no = rngnorth.Rows.Count
    Range("K3") = no
    
    'Average
    Dim myLastRown As Long
    'myLastRown is count after 60% separation
    myLastRown = Sheets("north").Range("F2").CurrentRegion.Rows.Count
    Dim rngn1 As Range
    Set rngn1 = Range(Cells(2, "H"), Cells(myLastRown, "H"))
    ave = WorksheetFunction.Average(rngn1)
    Range("K4") = ave
    Range("K4").NumberFormat = "0.00%"
    
    'Total Traffic
    Dim rngn2 As Range
    Set rngn2 = Range(Cells(2, "I"), Cells(myLastRown, "I"))
    tot = WorksheetFunction.Sum(rngn2)
    Range("K5") = tot
    
    'Low 10%
    Dim rngn3 As Range
    lowten = myLastRown - (myLastRown * 0.1)
    Set rngn3 = Range(Cells(myLastRown, "H"), Cells(lowten, "H"))
    worst = WorksheetFunction.Average(rngn3)
    Range("K6") = worst
    Range("K6").NumberFormat = "0.00%"
    
    'Low25%
    Dim rngn4 As Range
    lowqrt = myLastRown - (myLastRown * 0.25)
    Set rngn4 = Range(Cells(myLastRown, "H"), Cells(lowqrt, "H"))
    worstqtr = WorksheetFunction.Average(rngn4)
    Range("K7") = worstqtr
    Range("K7").NumberFormat = "0.00%"
    
    'Upper 25%
    Dim rngn5 As Range
    upqrt = myLastRown * 0.25
    Set rngn5 = Range(Cells(2, "H"), Cells(upqrt, "H"))
    upper = WorksheetFunction.Average(rngn5)
    Range("K8") = upper
    Range("K8").NumberFormat = "0.00%"
    
    


    
    
    Dim Eng As Range
    Dim RT As Long
    Dim Address As Range
    Set Address = Rows(1).Find(What:="Address", LookIn:=xlValues, LookAt:=xlWhole)
    RT = Cells(Rows.Count, Address.Column).End(xlUp).Row
    Address.Offset(, 1).EntireColumn.Insert
    Cells(1, Address.Column + 1).Value = "R&T"
    Range(Cells(2, Address.Column + 1), Cells(RT, Address.Column + 1)).Formula = "=VLOOKUP(E2,northern!B:G,6,0)"
    
    Dim Engr As Range
    Dim PAS As Long
    Set Address = Rows(1).Find(What:="R&T", LookIn:=xlValues, LookAt:=xlWhole)
    PAS = Cells(Rows.Count, Address.Column).End(xlUp).Row
    Address.Offset(, 1).EntireColumn.Insert
    Cells(1, Address.Column + 1).Value = "PAS"
    Range(Cells(2, Address.Column + 1), Cells(PAS, Address.Column + 1)).Formula = "=VLOOKUP(E2,northern!B:H,7,0)"
    
    Dim ws As Worksheet
    Set ws = Sheets("3G Traffic")
    ws.Activate
    ws.Unprotect
      
    With ws
    
    Dim lastColumn As Long
    lastColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
    Dim LC As Long
    LC = lastColumn + 1
    Dim sourcerange As Range
    Dim fillrange As Range
    Set sourcerange = .Range(.Cells(2, lastColumn), .Cells(7, lastColumn))
    Set fillrange = .Range(.Cells(2, lastColumn), .Cells(7, LC))
[COLOR=#ff0000]    sourcerange.AutoFill Destination:=fillrange, Type:=xlFillDefault[/COLOR]
    'sourcerange.Copy fillrange
   
    End With
   
    End Sub
[COLOR=#333333][FONT=Verdana]
[/FONT][/COLOR]

 
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA - Copying Range to an E-Mail Body
Replies
8
Views
333
Logit
Logit
D
  • Question Question
Generating Reports in Word Using Data in Excel
Replies
1
Views
600
Dan_W
D
KlausW
  • Solved
Excel VBA Error - Unable to get the Insert property of the Picture Class
Replies
7
Views
589
KlausW
KlausW
N
  • Question Question
Runtime error -2147417848 (80010108) method value of the object range failed
Replies
0
Views
869
nazeefmasood
N
2
  • Question Question
Run=time error '1004': Method 'Range of Object'_Global' failed
Replies
4
Views
731
2077delta
2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top