skipping code

[Cerebum]

The following is an extract from a longer piece of code that transfers vehicles from one location to another. The section below handles a log which shows outstanding transfers. The sheet works on serial numbers. The code is designed to list new vehicle loans and remove them from the list once the vehicle is returned. What I am struggling with is skipping the code between the notes (code which adds vehicles to the list) when the initial instruction clears out vehicle details.

Sub tester()
With Sheets("X")
    Set F = .Columns("C").Find(What:=.Range("D448").Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not F Is Nothing Then F.EntireRow.ClearContents
End With
' need to add a goto here somewhere but only when it clears contents

    With Sheets("X")
    .Range("B448:G448").Copy
    .Range("A445").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Range("A442:F445").Sort Key1:=Range("A442"), Order1:=xlAscending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With
  'need it to go here
    Range("F438:F440").Select
    Selection.Copy
    Range("F442").Select
    ActiveSheet.Paste
    
End Sub

Please excuse the rough code. I have improved significantly, thanks to the help I have received from this forum, but sometimes my dodgy foundations let me down.

Thanks

 

[doofusboy]

Sub tester()
With Sheets("X")
    Set F = .Columns("C").Find(What:=.Range("D448").Value, LookIn:=xlValues, LookAt:=xlWhole)
[COLOR=red][B]    If Not F Is Nothing Then [/B][/COLOR]
[COLOR=red][B]        F.EntireRow.ClearContents[/B][/COLOR]
[COLOR=red][B]        Exit Sub[/B][/COLOR]
[COLOR=red][B]    End If
[/B][/COLOR]End With
' need to add a goto here somewhere but only when it clears contents

 

[Cerebum]

Sub tester()
With Sheets("X")
    Set F = .Columns("C").Find(What:=.Range("D448").Value, LookIn:=xlValues, LookAt:=xlWhole)
[COLOR=red][B]    If Not F Is Nothing Then [/B][/COLOR]
[COLOR=red][B]        F.EntireRow.ClearContents[/B][/COLOR]
[COLOR=red][B]        Exit Sub[/B][/COLOR]
[COLOR=red][B]    End If
[/B][/COLOR]End With
' need to add a goto here somewhere but only when it clears contents

thanks, although this would drop me out of the code but I need to skip a couple of lines

 

[jim may]

Maybe something like this...

Sub tester()
With Sheets("X")
    Set F = .Columns("C").Find(What:=.Range("D448").Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not F Is Nothing Then F.EntireRow.ClearContents
'Why not remove the below End With continuing under your If statement

End With
' need to add a goto here somewhere but only when it clears contents
'and removing the below With Sheets("X") since you are continuing with the original With
    With Sheets("X")
    .Range("B448:G448").Copy
    .Range("A445").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Range("A442:F445").Sort Key1:=Range("A442"), Order1:=xlAscending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With  'AND REMOVE THIS
  'need it to go here
ELSE  ' INSERT THIS !!!
'Since your With statement has not been closed modify your remaining code to look like this:

    .Range("F438:F440").Copy
    .Range("F442")
End if
End With    
End Sub

 

[Cerebum]

Maybe something like this...

Sub tester()
With Sheets("X")
    Set F = .Columns("C").Find(What:=.Range("D448").Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not F Is Nothing Then F.EntireRow.ClearContents
'Why not remove the below End With continuing under your If statement

End With
' need to add a goto here somewhere but only when it clears contents
'and removing the below With Sheets("X") since you are continuing with the original With
    With Sheets("X")
    .Range("B448:G448").Copy
    .Range("A445").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Range("A442:F445").Sort Key1:=Range("A442"), Order1:=xlAscending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With  'AND REMOVE THIS
  'need it to go here
ELSE  ' INSERT THIS !!!
'Since your With statement has not been closed modify your remaining code to look like this:

    .Range("F438:F440").Copy
    .Range("F442")
End if
End With    
End Sub

This is definitely getting there The code I need to skip is the stuff just after the first unwanted end with, so, if I put the "Else" there that should do it, shouldn't it?

 

[jim may]

For me, I still have to Step-through all code (Using the F8 Function key) to "watch" each line of code to SEE if it is doing what I want; Try stepping thru code and write back with results.
Someone can help from there, if there is a problem//

 

[Cerebum]

For me, I still have to Step-through all code (Using the F8 Function key) to "watch" each line of code to SEE if it is doing what I want; Try stepping thru code and write back with results.
Someone can help from there, if there is a problem//

I tried putting "Else" in but it doesn't recognize it as an "IF" statement. I will try the F8 suggestion. Thanks.

 

[Cerebum]

RESOLVED

I used a case select & ran a section of the code selected by a countif in the sheet. Basically I added a countif to count if the serial number already appeared in the selection. if it found one it deleted it, if it found none it entered it into the grid.

This suggestion was a reworking of a solution to an earlier problem that i found in my user CP

God I love this site

Here's the code

Sub tester()
With Sheets("X")

Select Case Range("A448")
  Case 1
'if serial numbers match do the stuff below
    Set F = .Columns("C").Find(What:=.Range("D448").Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not F Is Nothing Then F.EntireRow.ClearContents
    .Range("A442:F445").Sort Key1:=Range("A442"), Order1:=xlAscending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Range("F438:F440").Select
    Selection.Copy
    Range("F442").Select
    ActiveSheet.Paste

    Case 0
    .Range("B448:G448").Copy
    .Range("A445").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Range("A442:F445").Sort Key1:=Range("A442"), Order1:=xlAscending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("F438:F440").Select
    Selection.Copy
    Range("F442").Select
    ActiveSheet.Paste
   
   Case Else
      MsgBox ("Houston, we have a problem!")
End Select
End With
End Sub

Cheers guys