Code unable to handle a certain condition..why?

ParanoidAndroid

Board Regular
Joined
Jan 24, 2011
Messages
50
Hi Guys

I have code which goes through each row in sheet "compile" and looks for a certain condition in column L from which it will cut and paste those rows where the condition is true into the appropriate sheet...

However sometimes the code crashes when a certain condition exists..

I'm theorising that my code expects a string value so crashes if otherwise

Whats in column L is a formula that reads from another spreadsheet..So sometimes you dont get a true value but rather #N/A - I dont have a problem with this but the code seems to?

Is this because i've defined the Dim as Integer? what should it be if so?

Code:
 Sub Time()

Dim LSearchRow As Integer
    Dim LCopyToRow As Integer
    
    Sheets("Compile").Activate
    On Error GoTo Err_Execute
    'Start search in row 4
    LSearchRow = 2
    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 2
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0
        'If value in column J = "Central", copy entire row to Central
        If Range("L" & CStr(LSearchRow)).Value = "Central " Then
            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            'Paste row into Sheet2 in next row
            Sheets("Central").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            'Go back to Sheet1 to continue searching
            Sheets("Compile").Select
        ElseIf Range("L" & CStr(LSearchRow)).Value = "Markets" Then
            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            'Paste row into Sheet2 in next row
            Sheets("Markets").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            'Go back to Sheet1 to continue searching
            Sheets("Compile").Select
        
                              
        End If
        LSearchRow = LSearchRow + 1
    
     Wend
     'Position on cell A3
     Application.CutCopyMode = False
          
     Exit Sub
Err_Execute:
    MsgBox "An error occurred."
    
    End Sub<!-- / message --><!-- sig -->
__________________
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
try this correction
Code:
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
    'If value in column J = "Central", copy entire row to Central
    If Not IsNA(Range("L" & CStr(LSearchRow)).Value ) Then
        If Range("L" & CStr(LSearchRow)).Value = "Central " Then
            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            'Paste row into Sheet2 in next row
            Sheets("Central").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            'Go back to Sheet1 to continue searching
            Sheets("Compile").Select
        ElseIf Range("L" & CStr(LSearchRow)).Value = "Markets" Then
            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            'Paste row into Sheet2 in next row
            Sheets("Markets").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            'Go back to Sheet1 to continue searching
            Sheets("Compile").Select                  
        End If
    end if
 
Upvote 0
Hi Didi

Fair Call..its just how it got cut and pasted...

I've tidied it up and removed code that is excess

Code:
Sub Time()
 
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
 
         Sheets("Compile").Activate
On Error GoTo Err_Execute
 
LSearchRow = 2 'Start search in row 4
LCopyToRow = 2 'Start copying data to row 2 in Sheet2 (row counter variable)
 
      While Len(Range("A" & CStr(LSearchRow)).Value) > 0
 
               If Range("L" & CStr(LSearchRow)).Value = "Central" Then 'If value in column L = "Central", copy entire row to Central
                        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 'Select row in compile to copy
                                       Selection.Copy
                                       Sheets("Central").Select 'Paste row into Central in next row
                                                Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
                                                ActiveSheet.Paste
                                        LCopyToRow = LCopyToRow + 1 'Move counter to next row
                        
                                        Sheets("Compile").Select 'Go back to Compile to continue searching
 
               End If
 
          LSearchRow = LSearchRow + 1
 
      Wend
                     Application.CutCopyMode = False
      Exit Sub
 
Err_Execute:
                     MsgBox "An error occurred."
 
Upvote 0
i think you missed the point... there is an extra If statement i have inserted....
 
Upvote 0
Oh..Obviously, I missed the point.

So your saying to add a line that says

if doesnt meet this condition then do this?

Prior to my post i put in a condition that said

If <> Central then do this....

But it made no difference,,,
 
Upvote 0
This method uses Autofilter to filter on all the "Central" rows and then copies all of them in one step.

Code:
Sub Time2()

    Application.ScreenUpdating = False
    
    With Sheets("Compile")
    
        With .Range("L1", .Range("L" & Rows.Count).End(xlUp))    ' Define filter range
        
            ' Filter and copy "Central"
            If Not .Find("Central", , , , xlWhole, , False) Is Nothing Then                     ' Test if any "Central" cells exist
                .AutoFilter Field:=1, Criteria1:="Central"                                      ' Filter on "Central"
                .Offset(1).Resize(.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                    Destination:=Sheets("Central").Rows(2)                                      ' Copy\Paste filtered cells
                .AutoFilter                                                                     ' Reset filter
            End If
            
            ' Filter and copy "Markets"
'            If Not .Find("Markets", , , , xlWhole, , False) Is Nothing Then                     ' Test if any "Markets" cells exist
'                .AutoFilter Field:=1, Criteria1:="Markets"                                      ' Filter on "Markets"
'                .Offset(1).Resize(.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
'                    Destination:=Sheets("Markets").Rows(2)                                      ' Copy\Paste filtered cells
'                .AutoFilter                                                                     ' Reset filter
'            End If
            
        End With
        
        .AutoFilterMode = False ' Turn off autofilter
    
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox """Central"" and ""Markets"" data copied.", vbInformation, "Copy Complete"
    
End Sub
 
Upvote 0
note new lines...

Code:
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
    'If value in column J = "Central", copy entire row to Central
    If Not IsNA(Range("L" & CStr(LSearchRow)).Value ) Then      '<-------------------
        If Range("L" & CStr(LSearchRow)).Value = "Central " Then
            'Select row in Sheet1 to copy
      .....etc

     end if    '<----------------------
 
Upvote 0
Hi AlphaFrog and Diddi...apologies for late reply. Thanks you both so much for your help.

I ended up using Alphas code simply because it functions much much faster

I found the problem I was having was because its looking for a string when there is a formula. So i needed "xlValues" into the formula so it knew what to look for.

I changed the following line in AlphaFrogs code - adding in the red part

Code:
If Not .Find("Central Operations - Institutional", , [COLOR=red]xlValues[/COLOR], , xlWhole, , False) Is Nothing Then

My next quesiton is how do I change this line in AlphaFrogs Code so that it copies "that" row starting at A but only going up to column J

Code:
.Offset(1).Resize(.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
 
Upvote 0
My next quesiton is how do I change this line in AlphaFrogs Code so that it copies "that" row starting at A but only going up to column J

Code:
.Offset(1).Resize(.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _

Try something like this...
Code:
.Offset(1[COLOR="Red"], -11[/COLOR]).Resize(.Count - 1[COLOR="Red"], 10[/COLOR]).SpecialCells(xlCellTypeVisible).Copy _
      Destination:=Sheets("Central").[COLOR="Red"]Range("A2")[/COLOR]

It offsets the filtered cells from column L to -11 columns (column A) and then resizes to +10 columns wide (Columns A:J).
 
Upvote 0
Thanks AlphaFrog

the .range(A2) in the destination wont seem to work?

I tried it with .rows(2) and it works fine but I want it to be pasted in a row in column G

Actually more specifically I want it to be pasted it into a variable row (I have a counter) but always in starting in column G

Code:
Destination:=Sheets("Central).Range("G" & LastRowCount + 1)

Note: I"ve tried it without the counter as well

Can it possibly be the .range in the code???
 
Upvote 0

Forum statistics

Threads
1,224,589
Messages
6,179,744
Members
452,940
Latest member
rootytrip

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