Vba program wont run second time

Question

This is my first question, so please be patient:)

I am not an experienced VBA programmer, and I have made my self some issues in my software.

I have a program wich pastes some data in and then adds some new columns. Afterwards it splits up some text and puts it inside the cells within the new columns.

The program works perfect the first time, but second time it looks like it is pasting the data in wrong. It has a different look, and the program fails when it is picking data from some cells witch apparently doesnt exist.

It gives me a error of: unable to get the average property of the worksheet function class

Hope you do have some good ideas. I have tried to clear all formats, content etc.

Thank you.

Here is my code, very sorry for bad programming style. I need to collect some of my loops in to something smoother, but first i need it to work:)

Thank you for your time!

   Option Explicit

Private Sub btnExit_Click()

Application.Quit


End Sub


Private Sub btni2_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False


Worksheets("System").Activate
Worksheets("System").Cells(1, 1).Select
ActiveCell.PasteSpecial

On Error GoTo myError:

Worksheets("System").Cells(2, 2) = "=COUNTA(A3:A10000)"
Dim laps As Integer
laps = Worksheets("System").Cells(2, 2)
'MsgBox ("Resultat er: " & laps)

' Opret nye kolloner til at seperare tekst fra I2.
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


'Flyt text til nye kolloner for at splitte data op
'Split A
    Range("A3:A10000").Select
    Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'Split C
    Range("C3:C10000").Select
    Selection.TextToColumns Destination:=Range("C3"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'Split E
    Range("E3:E10000").Select
    Selection.TextToColumns Destination:=Range("E3"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'Split G
    Range("G3:G10000").Select
    Selection.TextToColumns Destination:=Range("G3"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True


'check om der er data i Main arket
    Dim Check As String


    Check = Worksheets("Main").Range("B1").Value

    If Check = "" Then

        Worksheets("System").Range("A3").Copy
        Worksheets("Main").Select
        Range("B1").Select
        Selection.PasteSpecial
        Worksheets("System").Select

        Worksheets("System").Range("B3").Copy
        Worksheets("Main").Select
        Range("B2").Select
        Selection.PasteSpecial
        Worksheets("System").Select

        Worksheets("System").Range("C3").Copy
        Worksheets("Main").Select
        Range("B6").Select
        Selection.PasteSpecial
        Worksheets("System").Select

        Worksheets("System").Range("D3").Copy
        Worksheets("Main").Select
        Range("B4").Select
        Selection.PasteSpecial
        Worksheets("System").Select

        Worksheets("System").Range("E3").Copy
        Worksheets("Main").Select
        Range("B3").Select
        Selection.PasteSpecial
        Range("B7").Value = "Mads S. Christiansen"
        Worksheets("System").Select


    End If


    'definer alle de variabler der skal pastes ind i de respektive sessions
    Dim EditLaps As Integer
    Dim FastLap As Variant 'J
    Dim NoLaps As Integer 'inkl in/out brug variabel laps fra tidligere
    Dim TotalTime As Variant 'Sum af alle felter i J =sum(J3:J+laps)
    Dim TotalKm As Variant ' AM3 og AN & laps +3 trukket fra hinanden
    Dim MaxRpm As Long 'Max V3 til V & laps + 3
    Dim MaxWaterT As Double ' max O3 til O & laps + 3
    Dim AvgWaterT As Double ' avg O3 til O & laps + 3
    Dim MaxOilT As Double ' MAX Q3 til Q & laps + 3
    Dim AvgOilT As Double ' AVG
    Dim IntakeT As Double
    Dim MaxOilP As Double
    Dim MinOilP As Double
    Dim AvgOilP As Double
    Dim MaxCoolP As Double
    Dim MinCoolP As Double
    Dim AvgCoolP As Double
    Dim TotalKm1, TotalKm2 As Variant

    NoLaps = laps
    'Bruges som reference for at det passser med offset pga af første celle ref
    EditLaps = NoLaps + 2
    'Find hurtigste omgang og tildel den til FastLap
    FastLap = Application.WorksheetFunction.Min(Range(Cells(3, 10), Cells(EditLaps, 10)))
    ' Denne format virker !! Range("Z1").NumberFormat = "mm:ss.000"

    ' Total tid for session
    TotalTime = Format(Application.WorksheetFunction.Sum(Range(Cells(3, 10), Cells(EditLaps, 10))), "HH:MM:SS")

    'Total antal km for session, er dist slut minus dist start
    TotalKm1 = Range("AM3").Value
    TotalKm2 = Range("AN" & EditLaps).Value

    TotalKm = TotalKm2 - TotalKm1

    '------------------------------------------ Dette er for at convertere felte om til nummerisk formatering----------
    Dim a As Variant
    Dim b As Variant
    Dim c As Variant
    Dim d As Variant
    Dim e As Variant
    Dim f As Variant
    Dim g As Variant
    Dim h As Variant
    Dim i As Variant
    Dim j As Variant

    For Each a In Range("V1:V" & EditLaps)
    If a = "" Then GoTo nexta
    If IsNumeric(a) Then
        a.Value = a.Value * 1
        a.NumberFormat = "general"
    End If

nexta:
Next a

 For Each b In Range("N1:N" & EditLaps)
    If b = "" Then GoTo nextb
    If IsNumeric(b) Then
        b.Value = b.Value * 1
        b.NumberFormat = "general"
    End If

nextb:
Next b

For Each c In Range("O1:O" & EditLaps)
    If c = "" Then GoTo nextc
    If IsNumeric(c) Then
        c.Value = c.Value * 1
        c.NumberFormat = "general"
    End If

nextc:
Next c

For Each d In Range("K1:K" & EditLaps)
    If d = "" Then GoTo nextd
    If IsNumeric(d) Then
        d.Value = d.Value * 1
        d.NumberFormat = "general"
    End If

nextd:
Next d

For Each e In Range("L1:L" & EditLaps)
    If e = "" Then GoTo nexte
    If IsNumeric(e) Then
        e.Value = e.Value * 1
        e.NumberFormat = "general"
    End If

nexte:
Next e

For Each f In Range("Q1:Q" & EditLaps)
    If f = "" Then GoTo nextf
    If IsNumeric(f) Then
        f.Value = (f.Value * 1) / 1000
        f.NumberFormat = "general"
    End If

nextf:
Next f

For Each g In Range("P1:P" & EditLaps)
    If g = "" Then GoTo nextg
    If IsNumeric(g) Then
        g.Value = (g.Value * 1) / 1000
        g.NumberFormat = "general"
    End If

nextg:
Next g

For Each h In Range("R1:R" & EditLaps)
    If h = "" Then GoTo nexth
    If IsNumeric(h) Then
        h.Value = (h.Value * 1) / 1000
        h.NumberFormat = "general"
    End If

nexth:
Next h

For Each i In Range("T1:T" & EditLaps)
    If i = "" Then GoTo nexti
    If IsNumeric(i) Then
        i.Value = i.Value * 1
        If i.Value >= 1 Then
        i.Value = i.Value / 1000
        End If
        i.NumberFormat = "general"
    End If

nexti:
Next i

For Each j In Range("S1:S" & EditLaps)
    If j = "" Then GoTo nextj
    If IsNumeric(j) Then
        j.Value = j.Value * 1
        If j.Value >= 1 Then
        j.Value = j.Value / 1000
        End If
        j.NumberFormat = "general"
    End If

nextj:
Next j

    'Max rpm
    MaxRpm = Application.WorksheetFunction.Max(Range(Cells(3, "V"), Cells(EditLaps, "V")))

    'Max vand temp
    MaxWaterT = Application.WorksheetFunction.Max(Range(Cells(3, "N"), Cells(EditLaps, "N")))
    AvgWaterT = Application.WorksheetFunction.Average(Range(Cells(3, "O"), Cells(EditLaps, "O")))

    MaxOilT = Application.WorksheetFunction.Max(Range(Cells(3, "K"), Cells(EditLaps, "K")))
    AvgOilT = Application.WorksheetFunction.Average(Range(Cells(3, "L"), Cells(EditLaps, "L")))

    'IntakeT =

    MaxOilP = Application.WorksheetFunction.Max(Range(Cells(4, "Q"), Cells(EditLaps - 1, "Q")))
    MinOilP = Application.WorksheetFunction.Min(Range(Cells(4, "P"), Cells(EditLaps - 1, "P")))
    AvgOilP = Application.WorksheetFunction.Average(Range(Cells(4, "R"), Cells(EditLaps - 1, "R")))

    MaxCoolP = Application.WorksheetFunction.Max(Range(Cells(4, "T"), Cells(EditLaps - 1, "T")))
    MinCoolP = Application.WorksheetFunction.Min(Range(Cells(4, "S"), Cells(EditLaps - 1, "S")))
    AvgCoolP = Application.WorksheetFunction.Average(Range(Cells(4, "T"), Cells(EditLaps - 1, "T")))



    ' lav et object der indeholder det sheet som der skal bruges
    Dim Sheet As Object
    Set Sheet = Worksheets("Main")

    'Definer hvilken session der er kopieret ind
    Dim Session As String


    Session = UCase(Range("F3"))

    Select Case Session

    Case Is = " TEST"
        Set Sheet = Worksheets("Test")
    Case Is = " Q1"
        Set Sheet = Worksheets("Q1")
    Case Is = " Q2"
        Set Sheet = Worksheets("Q2")
    Case Is = " WU"
        Set Sheet = Worksheets("WU")
    Case Is = " RACE1"
        Set Sheet = Worksheets("Race1")
    Case Is = " RACE2"
        Set Sheet = Worksheets("Race2")
    End Select


    Sheet.Activate

    Range("B3").Value = FastLap
    Range("B4").Value = NoLaps
    Range("B5").Value = TotalTime
    Range("B7").Value = TotalKm
    Range("B13").Value = MaxRpm
    Range("B16").Value = MaxWaterT
    Range("B17").Value = AvgWaterT
    Range("B20").Value = MaxOilT
    Range("B21").Value = AvgOilT
    Range("B24").Value = 25
    Range("B27").Value = MaxOilP
    Range("B28").Value = MinOilP
    Range("B29").Value = AvgOilP
    Range("B32").Value = MaxCoolP
    Range("B33").Value = MinCoolP
    Range("B34").Value = AvgCoolP


    Sheet9.Activate
    Sheet9.Cells.Select
    With Cells
    .Clear
    .ClearComments
    .ClearContents
    .ClearFormats
    .ClearHyperlinks
    .ClearNotes
    .ClearOutline
    End With

    ' aktiver main siden efter endt handling af System seperation
    Worksheets("Main").Activate
    Cells(1, 1).Select
'Fjern hovedform fra billede og derefter vises Main arket.
MainForm.Hide


myError:
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        If Err Then MsgBox Err.Description, vbCritical, "Error"


End Sub

Private Sub btnView_Click()
' aktiver kun main sheet hvis der oenskes view.
Worksheets("Main").Activate
'marker celle
Cells(1, 1).Select
'gem main form sΠder kun er normalt excel view
MainForm.Hide

End Sub

Answer 1

Answer posted before code added to question

An easy mistake for the new VBA programmer is to write a macro that operates on the active worksheet. This works well until you look at another sheet before calling your macro.

For example, you might write:

Range("A1").Value = "abc"
Cells(29, "B").Font.Bold = True

The above statements operates on the active worksheet.

With Worksheets("Master")
  .Range("A1").Value = "abc"
  .Cells(29, "B").Font.Bold = True
End With

In this second example, I have explicitly written that I want to my statements to operate on worksheet Master. Note that I have added a dot before Range and before Cells. Written like this, it does not matter which sheet you were looking at when you started the macro.

Not using a With statement to specify the target worksheet is only one example of writing code that only works if the cursor is in the correct place when the macro is started. The symptoms you describe match this type of error.

Look at your code. What assumptions does it make? If this does not help, do as Kevin asks and post your code. To do this:

• Edit your question.
• Copy your code into the question.
• Select the code and then click the curly brackets above the edit window. This adds four spaces to the beginning of each line which cause it to be displayed as code.

Answer posted after code added to question

I have been working through some of your code. I cannot run it properly because I have no context; I do not know what sort of data it is operating on.

However, the following comments may be useful. I will add more as I discover things to say.

You do not want either of these commands during debugging.

'Application.ScreenUpdating = False
'Application.DisplayAlerts = False

Whatever you are trying to do, I do not believe this is a good way of achieving it. I have had to delete it so I can get to statements I can run. Edit Having worked through some of your code and gained an understanding of it, I wonder if this is the cause of your problem. I discuss this later when I get to the code that allowed be to better understand what you are doing.

'Worksheets("System").Activate
'Worksheets("System").Cells(1, 1).Select
'ActiveCell.PasteSpecial

I never include error handling in my own macros until I want to release them to others. During testing, I want the macro to stop on the faulty statement and not to fail gracefully with an error message whose source I do not know.

'On Error GoTo myError:

I prefer to group all my variables at the top of the macro so I can find them easily. This is not necessary, just my preference. On a 32-bit system, Long is the native size for an integer value. Integer specifies a 16-bit variable and requires special handling and will result in slower execution.

Dim laps As Long

I have changed the following so it uses a With statement rather than switch worksheets and select cells. Switching and selection is slow and can get very confusing. Don't do either unless you have to.

With Worksheets("System")
  .Cells(2, 2).Value = "=COUNTA(A3:A10000)"
  laps = .Cells(2, 2).Value
End With

I assume the above is trying to determine the number of lines loaded by the earlier paste. The trouble is this is counting the number of blank lines. Are you absolutely sure blank lines are impossible? I also assume that 10,000 represents the more rows than could possibly be loaded by the paste.

There are various techniques for finding the bottom row; none of which work in every situation. The easiest technique is:

Dim RowLast As Long
With Worksheets("System")
  RowLast = .Cells(Rows.Count, "A").End(XlUp).Row
End With

Rows.Count is the maximum number of rows for your version of Excel. This VBA is the equivalent of placing the cursor in the bottom row of column "A" and then clicking Ctrl+Up which jumps to the last row in column "A" with a value. The number of that row is placed in LastRow.

Consider this code:

  Columns("B:B").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("D:D").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("F:F").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("H:H").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

The objective of the above code is to create a blank column before each of columns B, C, D and E. However, inserting a column before column B move column C to column D. I am told that performing the insertions from left to right is slightly faster than performing them from right to left but I do not care. If a routine is to be performed thousands of time per day or if it really is slow then I will think about efficiency. But I will not write code I find difficult to understand if all it saves is a few milliseconds.

A problem with VBA is that there are always several method of achieving the same effect and often no obvious reason why one method is better than another. In my version of your code I have used insert column. I have not performed any timings - so I do not know which method, if either, is faster - I just find insert column clearer.

I assume "Opret nye kolloner til at seperare tekst fra I2" says why you are doing this. Note that I have added what and how. When I come back to this code in six or twelve months I do not want to have to study the code to discover what, why or how; I want to be told. The Unix operating system is said to be beautifully documented but that it was not always so. Apparently a block of code was headed: "Once only God and I knew what this routine does. Now God alone knows." You do not want to have to say that about your own code. I like to look at my own code a week or two after I wrote it and while I still more-or-less remember what it does. If I struggle to understand, I know it needs more comments.

Dim ColCodeCrnt As Variant

With Worksheets("WRASystem")
  ' Insert a blank column before each of columns E, D, C and B.
  ' Insertions in reverse order to make code clearer since an
  ' insertion before column B moves column C.
  For Each ColCodeCrnt In Array("E", "D", "C", "B")
    .Columns(ColCodeCrnt).EntireColumn.Insert
  Next
End With

Now consider the block starting:

  Range("A3:A10000").Select
  Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
      TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
      Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
      :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

From this I deduce that the block you paste in at the beginning has N rows and 4 columns. Each cell contains "Value1,Value2". You are splitting the values so "Value 1" remains in column A while "Value2" goes to newly emptied column B. This is repeated for columns C, E and G.

As I said before, I assume 10000 represents an impossibly large row number for the size of the block. I have shown you above how to get the actual last row of a worksheet. In a moment, I will show you how to use the number of the last row to improve this code. However, I have a problem that needs to be addressed first.

You call this macro btni2_Click(). My guess is that the user selects a range of interest and clicks button i2. Your code pastes that range into worksheet System and then plays with it. But that relies on worksheet System being empty. If the new range has fewer rows that the last range, your code will operate on the new range and some of the older range.

Consider this code:

Sub btni2_Click()

  Dim AddrSrc As String
  Dim WkShtSrc As String

  WkShtSrc = Selection.Worksheet.Name
  AddrSrc = Selection.Address

  Debug.Print WkShtSrc & "!" & AddrSrc

  With Worksheets("System")
    .Cells.EntireRow.Delete
    Range(WkShtSrc & "!" & AddrSrc).Copy Destination:=.Range("A1")
  End With

The first thing this code does is record the details of the selected range. I have included a Debug.Print so you can see what I have saved. I can then do whatever I like without losing the details of the selection. If fact, all I do is delete every row in the worksheet (that is, clear it) before copying the source range to the rectangle starting at cell A1.

I now recommend this code as a replacement for yours. Notes: (1) there is no selection; (2) the destination range has a dot at the beginning to indicate that it is qualified by the With statement; (3) I build the ranges which allows me to include them in a loop. I have not changed the parameters to TestToColumns because I do not know anything about the data being split.

  With Worksheets("WRASystem")
    For Each ColCodeCrnt In Array("A", "C", "E", "G")
      .Range(ColCodeCrnt & "3:" & ColCodeCrnt & RowLast).TextToColumns _
              Destination:=.Range(ColCodeCrnt & "3"), DataType:=xlDelimited, _
              TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
              Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
              FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
             TrailingMinusNumbers:=True
    Next
  End With

I will not look at any more of your code. I have given you much to think about and I might have discovered the cause of your problem. Come back with more questions if necessary.