An incorrect variable value is being written to a cell

[RockandGrohl]

Hi all, my whole code extract is below and the highlighted bold red parts are giving me grief.

Suddenly, last week, out of the blue, this error started cropping up.

I need to determine whether a tour type is Coach, Rail, Air or Self Drive. I make this determination near the start of the code and write it to temp sheet cell A8. This is then referred to multiple times throughout the process and has always been working nicely until last week. Be warned, the code is long but the important parts are highlighted.

I should note that the format of my sheet is a vertical list of titles, and then in cells K, L, M and N are flags for the type of tour. If I want the tour to be an air tour, I put "Y" in the corresponding column. This prompts my automated process to only select Air products.

Private Sub SuperAuto_Click()

Dim Lastrow, LastrowAD As Long, WB As Workbook
Dim TourCopyRng As Range
Dim DateCopyRng As Range
Dim NameCopyRng As Range
Dim CostCopyRng As Range




Set ads = Worksheets("Adselect")
Set atm = Worksheets("ATM")
Set am = Worksheets("AM")
Set AMPD = Worksheets("AMPD")
Set cap = Worksheets("CAP")
Set tod = Worksheets("TOD")
Set mt = Worksheets("MacroTimings")
Set tt = Worksheets("Theatre Tours")
Set rs = Worksheets("Rail Supplement")
Set temp = Worksheets("Temp")
Set WB = ActiveWorkbook
wbyr = 2019


Application.ScreenUpdating = False
ControlPanel.Hide




Overwrite = False




Dim start_time, end_time
mt.Range("F2").Value = Format(Now(), "hh:mm:ss")


Worksheets("Temp").Cells.Clear


ads.Activate
WCD = Range("A1").Value
WCDV = DateValue(Range("A1").Value)
JGtdate = WCDV + 42
OMtdate = WCDV + 21


Omega = False
JG = False


Do Until Cells(ActiveCell.Row, "A").Value = "" ' Main Loop
start_time = Now()
Success = False


If Cells(ActiveCell.Row, "G").Value = "" Then
MsgBox "No template in current ad!"
Exit Sub
End If


If Overwrite = False And Cells(ActiveCell.Row, "E").Value = "Y" Then
    GoTo Skip
End If




If Cells(ActiveCell.Row, "A").Value = "JP Filler Ads" Then
    Call JPFiller
    GoTo Skip
End If


If Overwrite = False Then
    Do Until Cells(ActiveCell.Row, "E").Value = ""
    ActiveCell.Offset(1, 0).Activate
    Loop
End If


PapNam = Cells(ActiveCell.Row, "A").Value
template = Cells(ActiveCell.Row, "G").Value
templatesize = Cells(ActiveCell.Row, "C").Value
AdVal = Cells(ActiveCell.Row, "D").Value
comp = Cells(ActiveCell.Row, "F").Value
tourreq = Cells(ActiveCell.Row, "H").Value


If InStr(Cells(ActiveCell.Row, "G").Value, "TH_") > 0 Then
Theatre = True
Else
Theatre = False
End If


ProgBox.ProgTitleNameFront.Caption = PapNam
ProgBox.ProgTitleNameBack.Caption = PapNam
ProgBox.TemplateLabelFront = template
ProgBox.TemplateLabelBack = template
ProgBox.ProgStatusFront.Caption = Range("H1").Value
ProgBox.ProgStatusBack.Caption = Range("H1").Value


Load ProgBox
With ProgBox
  .StartUpPosition = 0
  .Left = Application.Left + (0.05 * Application.Width) - (0.05 * .Width)
  .Top = Application.Top + (0.05 * Application.Height) - (0.05 * .Height)
  .Show vbModeless
End With


If Cells(ActiveCell.Row, "F").Value = "Just Go" Then
JG = True
Omega = False
Else
Omega = True
JG = False
End If


[B][COLOR=#ff0000]EU = False[/COLOR][/B]
[B][COLOR=#ff0000]Rail = False[/COLOR][/B]
[B][COLOR=#ff0000]Air = False[/COLOR][/B]
[B][COLOR=#ff0000]SD = False[/COLOR][/B]




[B][COLOR=#ff0000]If Cells(ActiveCell.Row, "K").Value = "Y" Then[/COLOR][/B]
[B][COLOR=#ff0000]EU = True[/COLOR][/B]
[B][COLOR=#ff0000]End If[/COLOR][/B]
[B][COLOR=#ff0000]If Cells(ActiveCell.Row, "L").Value = "Y" Then[/COLOR][/B]
[B][COLOR=#ff0000]Rail = True[/COLOR][/B]
[B][COLOR=#ff0000]End If[/COLOR][/B]
[B][COLOR=#ff0000]If Cells(ActiveCell.Row, "M").Value = "Y" Then[/COLOR][/B]
[B][COLOR=#ff0000]Air = True[/COLOR][/B]
[B][COLOR=#ff0000]End If[/COLOR][/B]
[B][COLOR=#ff0000]If Cells(ActiveCell.Row, "N").Value = "Y" Then[/COLOR][/B]
[B][COLOR=#ff0000]SD = True[/COLOR][/B]
[B][COLOR=#ff0000]End If[/COLOR][/B]
[B][COLOR=#ff0000]If SD = False And Rail = False And Air = False Then[/COLOR][/B]
[B][COLOR=#ff0000]Coach = True[/COLOR][/B]
[B][COLOR=#ff0000]End If[/COLOR][/B]


temp.Activate
Cells.ClearContents
temp.Range("A1").Value = "Paper Name"
temp.Range("A2").Value = PapNam
temp.Range("A3").Value = template
temp.Range("A4").Value = templatesize
temp.Range("A5").Value = tourreq
temp.Range("A6").Value = comp
temp.Range("A7").Value = AdVal
temp.Range("B1").Value = "Primary Pickups"
temp.Range("B2").FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,AMPD!C5:C12,8,0),"""")"
temp.Range("B2").Value = temp.Range("B2").Value
If Coach = True Then
temp.Range("B3").FormulaR1C1 = "=iferror(coachSTR(R2C2),"""")"
temp.Range("B3").Value = temp.Range("B3").Value
End If
If Rail = True Then
temp.Range("B3").FormulaR1C1 = "=iferror(railSTR(R2C2),"""")"
temp.Range("B3").Value = temp.Range("B3").Value
End If
If Air = True Then
temp.Range("B3").FormulaR1C1 = "=iferror(airSTR(R2C2),"""")"
temp.Range("B3").Value = temp.Range("B3").Value
End If


temp.Columns("A:A").EntireColumn.AutoFit


    tempdonk = 0
    Range("B5").Activate
    Do Until tempdonk = 13
    ActiveCell.Value = "Pickup " & tempdonk + 1
    tempdonk = tempdonk + 1
    ActiveCell.Offset(0, 1).Activate
    Loop ' Naming Temp Sheet Pickups Loop


' Splitting Pickups
Range("B2").Copy Range("B6")
Range("B6").Activate
ActiveCell.Replace What:=", ", Replacement:=",", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveCell.TextToColumns Destination:=Range("B6"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True


' Determining Pickup Travel Type


    Do Until Cells(6, ActiveCell.Column).Value = ""
        
        If ActiveCell Like "Flying*" Then
        ActiveCell.Offset(1, 0).Value = "Air"
        End If
        
        If ActiveCell Like "(RS)*" Then
        ActiveCell.Offset(1, 0).Value = "Rail"
        End If
        
        If ActiveCell Like "Making*" Then
        ActiveCell.Offset(1, 0).Value = "Self Drive"
        End If
        
        If ActiveCell.Offset(1, 0).Value = "" Then
        ActiveCell.Offset(1, 0).Value = "Coach"
        End If
        
        ActiveCell.Offset(0, 1).Activate
    Loop ' Pickup Travel Type Loop


' Adding Rail Supplement in




If Rail = True Then
    Range("B7").Activate
    Do Until Cells(7, ActiveCell.Column).Value = ""
    If ActiveCell.Value = "Rail" Then
        ActiveCell.Offset(-3, 0).FormulaR1C1 = "=IFERROR(INDEX('Rail Supplement'!C2,MATCH(Temp!R6C,'Rail Supplement'!C1,0)),0)"
        ActiveCell.Offset(-3, 0).Value = ActiveCell.Offset(-3, 0).Value
        RSUP = ActiveCell.Offset(-3, 0).Value
    End If
    ActiveCell.Offset(0, 1).Activate
    Loop
End If


' Determine what Travel type to go with for the tour
[B][COLOR=#ff0000]temp.Range("A8").ClearContents[/COLOR][/B]
Range("B5").Activate
PUdonk = 0


[COLOR=#ff0000][B]If Rail = True Then[/B][/COLOR]
[B][COLOR=#ff0000]Range("A8").Value = "Rail"[/COLOR][/B]
    Do Until Cells(5, ActiveCell.Column).Value = ""
        If ActiveCell.Offset(2, 0).Value = "Rail" Then
        ActiveCell.Offset(1, 0).Value = "Train to London"
        PUdonk = PUdonk + 1
        ActiveCell.Offset(3, 0).Value = "PU" & PUdonk
        End If
    ActiveCell.Offset(0, 1).Activate
    Loop
Range("B5").Activate
PUdonk = 0
End If


[B][COLOR=#ff0000]If Air = True Then[/COLOR][/B]
[B][COLOR=#ff0000]Range("A8").Value = "Air"[/COLOR][/B]
   Do Until Cells(5, ActiveCell.Column).Value = ""
        If ActiveCell.Offset(2, 0).Value = "Air" Then
        PUdonk = PUdonk + 1
        ActiveCell.Offset(3, 0).Value = "PU" & PUdonk
        End If
    ActiveCell.Offset(0, 1).Activate
    Loop
Range("B5").Activate
PUdonk = 0
End If


[COLOR=#ff0000][B]If SD = True Then[/B][/COLOR]
[COLOR=#ff0000][B]Range("A8").Value = "SD"[/B][/COLOR]
   Do Until Cells(5, ActiveCell.Column).Value = ""
        If ActiveCell.Offset(2, 0).Value = "Self Drive" Then
        PUdonk = PUdonk + 1
        ActiveCell.Offset(3, 0).Value = "PU" & PUdonk
        End If
    ActiveCell.Offset(0, 1).Activate
    Loop
Range("B5").Activate
PUdonk = 0
End If


[COLOR=#ff0000][B]If Coach = True Then[/B][/COLOR]
[COLOR=#ff0000][B]Range("A8").Value = "Coach"[/B][/COLOR]
   Do Until Cells(5, ActiveCell.Column).Value = ""
        If ActiveCell.Offset(2, 0).Value = "Coach" Then
        PUdonk = PUdonk + 1
        ActiveCell.Offset(3, 0).Value = "PU" & PUdonk
        End If
    ActiveCell.Offset(0, 1).Activate
    Loop
Range("B5").Activate
PUdonk = 0
End If


' Assign pickups


Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU1" Then
    PU1 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU1 = ""
    End If
ActiveCell.Offset(0, 1).Activate
Loop
Range("B5").Activate
Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU2" Then
    PU2 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU2 = "Blank"
    End If
ActiveCell.Offset(0, 1).Activate
Loop
Range("B5").Activate
Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU3" Then
    PU3 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU3 = "Blank"
    End If
ActiveCell.Offset(0, 1).Activate
Loop
Range("B5").Activate
Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU4" Then
    PU4 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU4 = "Blank"
    End If
ActiveCell.Offset(0, 1).Activate
Loop
Range("B5").Activate
Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU5" Then
    PU5 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU5 = "Blank"
    End If
ActiveCell.Offset(0, 1).Activate
Loop
Range("B5").Activate
Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU6" Then
    PU6 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU6 = "Blank"
    End If
ActiveCell.Offset(0, 1).Activate
Loop
Range("B5").Activate
Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU7" Then
    PU7 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU7 = "Blank"
    End If
ActiveCell.Offset(0, 1).Activate
Loop
Range("B5").Activate
Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU8" Then
    PU8 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU8 = "Blank"
    End If
ActiveCell.Offset(0, 1).Activate
Loop
Range("B5").Activate
Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU9" Then
    PU9 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU9 = "Blank"
    End If
ActiveCell.Offset(0, 1).Activate
Loop
Range("B5").Activate
Do Until Cells(5, ActiveCell.Column) = ""
    If ActiveCell.Offset(3, 0).Value = "PU10" Then
    PU10 = ActiveCell.Offset(1, 0).Value
    Exit Do
    Else
    PU10 = "Blank"
    End If
ActiveCell.Offset(0, 1).Activate
Loop


Application.DisplayAlerts = False


temp.Range("A11").Value = "Applicable Tours"
temp.Range("H11").Value = "Automated Tours"
temp.Range("I11").Value = "Tour Name"
temp.Range("J11").Value = "Price"
temp.Range("K11").Value = "Rank"
temp.Range("L11").Value = "Points"
temp.Range("M11").Value = "Manual Weighting"
adopen = False


Application.DisplayAlerts = True
For Each wbk In Workbooks
    If wbk.Name = "Advert Data " & wbyr & ".csv" Then
    adopen = True
    wbk.Activate
    Set ad = ActiveWorkbook
        If ad.ReadOnly = True Then
        ads.Activate
        ad.Close False
        adopen = False
        End If
    End If
Next
Application.DisplayAlerts = False


If adopen <> True Then
Application.DisplayAlerts = False
Set ad = Workbooks.Open("H:\Sales\Regional Press Selections\" & wbyr & "\Advert Data " & wbyr & ".csv", False, True)
Application.DisplayAlerts = True
Else
Application.DisplayAlerts = False
ad.Activate
Application.DisplayAlerts = True
End If


Application.DisplayAlerts = False


LastrowAD = Cells(Rows.Count, "A").End(xlUp).Row


Set TourCopyRng = Range("A2:A" & LastrowAD)
Set DateCopyRng = Range("E2:E" & LastrowAD)
Set NameCopyRng = Range("C2:C" & LastrowAD)
Set CostCopyRng = Range("G2:G" & LastrowAD)




Range("W2").FormulaArray = "=COUNT(SEARCH({"", " & PU1 & ","","", " & PU2 & ","","", " & PU3 & ","","", " & PU4 & ","","", " & PU5 & ",""},"", ""&RC[-14]&"",""))"
Range("W2").Select
Selection.AutoFill Destination:=Range("W2:W" & LastrowAD)




    
    If JG = True Then
    ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=5, Criteria1:=">=" & CLng(DateValue(JGtdate))     ' Tour date
    Else
    ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=5, Criteria1:=">=" & CLng(DateValue(OMtdate))     ' Tour date
    End If
    
    ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=12, Criteria1:="="                              ' Ad Week blank
    ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=2, Criteria1:="Active"                          ' Status Active
    ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=23, Criteria1:=">0"                             ' Applicable Pickup
    If JG = True Then   'Adding Theatre Tours in
    Else
    If Theatre = True Then
    Range("U2:U" & LastrowAD).FormulaR1C1 = "=IF(COUNTIF('[Super Automation.xlsm]Theatre Tours'!C1,RC[-18])>0, ""Y"","""")"
    Range("U2:U" & LastrowAD).Copy
    Range("U2").PasteSpecial xlPasteValues
    ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=21, Criteria1:="Y"                              ' Theatre
    Else
    Range("U2:U" & LastrowAD).FormulaR1C1 = "=IF(COUNTIF('[Super Automation.xlsm]Theatre Tours'!C1,RC[-18])>0, ""Y"","""")"
    Range("U2:U" & LastrowAD).Copy
    Range("U2").PasteSpecial xlPasteValues
    ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=21, Criteria1:=""                              ' Non-Theatre
    End If
    End If
[B][COLOR=#ff0000]    If JG = True Then[/COLOR][/B]
[B][COLOR=#ff0000]    ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=10, Criteria1:="<>*Omega*", Operator:=xlAnd, Criteria2:="<>*Albion*"[/COLOR][/B]
[B][COLOR=#ff0000]    Else[/COLOR][/B]
[B][COLOR=#ff0000]    ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=10, Criteria1:="*Omega*"[/COLOR][/B]
[B][COLOR=#ff0000]        If Rail = True Then[/COLOR][/B]
[B][COLOR=#ff0000]        ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=3, Criteria1:="*Rail*"[/COLOR][/B]
[B][COLOR=#ff0000]        End If[/COLOR][/B]
[B][COLOR=#ff0000]        If SD = True Then[/COLOR][/B]
[B][COLOR=#ff0000]        ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=3, Criteria1:="*h&t*"[/COLOR][/B]
[B][COLOR=#ff0000]        End If[/COLOR][/B]
[B][COLOR=#ff0000]        If Coach = True Then[/COLOR][/B]
[B][COLOR=#ff0000]        ActiveSheet.Range("$A$1:$W$" & LastrowAD).AutoFilter Field:=3, Criteria1:="<>" & "*airport*"[/COLOR][/B]
[B][COLOR=#ff0000]        End If[/COLOR][/B]
        
    End If
    
    


On Error GoTo NoTours
TourCopyRng.SpecialCells(xlCellTypeVisible).Copy temp.Range("A12")
NameCopyRng.SpecialCells(xlCellTypeVisible).Copy temp.Range("B12")
DateCopyRng.SpecialCells(xlCellTypeVisible).Copy temp.Range("C12")
CostCopyRng.SpecialCells(xlCellTypeVisible).Copy temp.Range("D12")
ad.Close False
On Error GoTo 0




temp.Activate


' Scrub away 3rd Party Tours
Range("B12").Activate
Do Until Cells(ActiveCell.Row, "B").Value = ""
    If InStr(1, ActiveCell.Value, "ripsmith", 1) > 0 Then
    Rows(ActiveCell.Row).Delete
    ActiveCell.Offset(-1, 0).Activate
    End If
    If InStr(1, ActiveCell.Value, "ravelzoo", 1) > 0 Then
    Rows(ActiveCell.Row).Delete
    ActiveCell.Offset(-1, 0).Activate
    End If
    If InStr(1, ActiveCell.Value, "owcher", 1) > 0 Then
    Rows(ActiveCell.Row).Delete
    ActiveCell.Offset(-1, 0).Activate
    End If
    If InStr(1, ActiveCell.Value, "tison", 1) > 0 Then
    Rows(ActiveCell.Row).Delete
    ActiveCell.Offset(-1, 0).Activate
    End If
    If InStr(1, ActiveCell.Value, "celolly", 1) > 0 Then
    Rows(ActiveCell.Row).Delete
    ActiveCell.Offset(-1, 0).Activate
    End If
ActiveCell.Offset(1, 0).Activate
Loop


Tourcount = Cells(Rows.Count, "A").End(xlUp).Row - 11
temp.Range("A10").Value = Tourcount


If temp.Range("A10").Value = 0 Or temp.Range("A10").Value = "" Then
GoTo NoTours
End If


' Now select!
Application.ScreenUpdating = False
Call SuperAutomation.SuperAutomation
Application.ScreenUpdating = False


' Amend Rail Price
If Rail = True Then
Range("J12").Activate
    Do Until Cells(ActiveCell.Row, "J").Value = ""
    ActiveCell.Value = ActiveCell.Value + RSUP
    ActiveCell.Offset(1, 0).Activate
    Loop
End If


' Place in Advert Data
Application.ScreenUpdating = False
Call SACommit
Application.ScreenUpdating = False
' Finish Up
Application.ScreenUpdating = False
temp.Activate
Cells.ClearContents
ads.Activate
end_time = Now()
Cells(ActiveCell.Row, "O").Value = Format(end_time - start_time, "h:mm:ss")
Success = True
NoTours:
On Error Resume Next
Resume Skip
On Error GoTo 0
Skip:
ads.Activate
ActiveCell.Offset(1, 0).Activate
On Error GoTo 0


If Success = True Then
WB.Save
Range("AA1").Value = ""
End If


' Update Progress Box


If ActiveCell.Row < 4 Then
Else
LastTime = Cells(ActiveCell.Row, "O").End(xlUp).Value
End If
TotTime = Format(Now() - mt.Range("F2").Value, "hh:mm:ss")
ProgBox.TotalTime.Caption = TotTime
ProgBox.LastSelect.Caption = Format(LastTime, "hh:mm:ss")
ProgBox.Repaint


Loop ' Main Loop


Unload ProgBox
Application.ScreenUpdating = True


MsgBox "Super Automation Done!"


End Sub

What's happening is that lets say a previous temp sheet had details filled in for "Coach" and the next iteration in the loop is for "Rail", for some reason, though every other detail in the temp sheet is changing, when cell A8 is written to, Coach is still there.

I actually tried manually clearing the cell before it is re-written, but that doesn't seem to work.

And the problem is that my macro is trying to write coach pickups to a paper with rail availability only.


I'm not sure why this has stopped working now to be honest!


Another curiosity is that when I get the error message (invalid call or procedure) and I halt the macro, if I restart it, it works and does everything it should perfectly.

 

[RockandGrohl]

Yet another curiosity is that the temp sheet keeps getting hidden, but there is absolutely nowhere in the code for this to happen....

 

[offthelip]

There is a lot of code there, one thing that I notice is that you start using activecell without ever specifying what cell is active. you activate worksheet but never activate a specific cell.
Using active cell in a code like this is not good practice and should be avoided , it is possible that this is the cause of your problem.. you should use a different sort of loop control such as
for each cell in a range.
Another thing I noticed you have "set" a lot a variables to worksheets without defining them as type worksheet, I do wonder whether this might cause a problem with the variable "temp"

 

[RockandGrohl]

Hi offthelip, thanks for the input.

Did I miss some worksheet variable declarations? I thought at the top I have them all declared:

Set ads = Worksheets("Adselect")Set atm = Worksheets("ATM")
Set am = Worksheets("AM")
Set AMPD = Worksheets("AMPD")
Set cap = Worksheets("CAP")
Set tod = Worksheets("TOD")
Set mt = Worksheets("MacroTimings")
Set tt = Worksheets("Theatre Tours")
Set rs = Worksheets("Rail Supplement")
Set temp = Worksheets("Temp")

Is there a better way I should be using instead of Set? I've not come across it.

I've never used for each before either

I think I've picked up a lot of bad habits from my predecessor. Like activating cells to obtain data etc. Your first point where I start using active cell without specifying what cell is active, where do I do this? I basically click on whatever row I want the loop to start from and then press the macro button to activate it, so I can choose where in the list I start the looping from.

 

[RockandGrohl]

I think I solved the disappearing temp sheet conundrum, I came back from holiday and the temp sheet was missing. I changed the code from deleting and re-creating a temp sheet to just clearing the contents, but it was looking for "temp" whereas the sheet I created was called "Temp" - by renaming the sheet to lowercase, it no longer gets hidden.

Curious.

EDIT: No, nevermind.

 

[offthelip]

your set statements do not define the type of an object. Excel defaults to defining an object as a variant.
So this statement:

[COLOR=#333333]Set temp = Worksheets("Temp")[/COLOR]

Assigns the worksheets"Temp" to a variant object which at this point takes on the type of a worksheet.
The "proper" way of doing this is to define the variable as a worksheet before assigning it like this:

Dim temp as worksheet
[COLOR=#333333]Set temp = Worksheets("Temp")[/COLOR]

 

[RockandGrohl]

your set statements do not define the type of an object. Excel defaults to defining an object as a variant.
So this statement:

[COLOR=#333333]Set temp = Worksheets("Temp")[/COLOR]

Assigns the worksheets"Temp" to a variant object which at this point takes on the type of a worksheet.
The "proper" way of doing this is to define the variable as a worksheet before assigning it like this:

Dim temp as worksheet
[COLOR=#333333]Set temp = Worksheets("Temp")[/COLOR]

Hi, this has been sorted.

I've also now implemented a rather extensive logging procedure with 27 checkpoints, so I can now see at which point the process is falling over.