Problems with InStr

G

georgep93

New Member
Joined
Feb 15, 2017
Messages
24
Hi all,

Was hoping someone could help, I have written the below:

Code: 
Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
branchCol = .Range("1:1").Find(What:="Property_Branch", LookAt:=xlPart).Column
            Set dltRange = Range(Cells(Lastrow, branchCol), Cells(2, branchCol))
            'delete any testing values
            With dltRange
                For dltctr = Lastrow To 2 Step -1
                    If InStr(LCase(dltRange(dltctr)), "testing") <> 0 Then
                        dltRange(dltctr).EntireRow.Delete
                    End If
                    
                Next dltctr
             End With

This is within a much larger script, it doesn't create any errors, but there is one row with "testing" inside it, and it never gets deleted? I have checked the range address it is looking at and this correct, can anyone see where I have gone wrong?

Thanks in advance.
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
Your code works for me.
Do you have any merged cells?
 
Upvote 0
Hi Fluff,

Thanks for coming back to me so quickly, no merged cells whatsoever as it is just running through a data page with no formatting at all. Unfortunately I don't think I should post the actual workbook here as its for work and not sure if they would like me sharing the data. I'll post the whole script, as it may be something else throwing it off?

Code: 
Private Sub updateSheets()

'Declare variables
Dim unhideSht As Worksheet, inspectSht As Worksheet, worksSht As Worksheet, depositSht As Worksheet, _
safetySht As Worksheet, ws As Worksheet, lookup As Worksheet


Dim wb As Workbook


Dim Lastrow As Long, lastCol As Long, i As Long, x As Long, ctr As Long, pmcCol As Long, daysCol As Long, branchCol As Long




Dim inputDate As String, depositFilter As String, safetyFilter As String, worksFilter As String, inspectionsFilter As String, _
stPath As String, matcher As String


Dim OutlookOpened As Boolean
Dim outApp As Outlook.Application
Dim outNs As Outlook.Namespace
Dim outFolder As Outlook.MAPIFolder
Dim outAttachment As Outlook.Attachment
Dim outMailItem As Outlook.MailItem


Dim ob_FSO As Object, ob_CheckFolder As Object, ob_File As Object, outItem As Object


Dim counter As Integer, dltctr As Integer, folderCheck As Integer, dlCount As Integer


Dim pt As PivotTable


Dim searchRange As Range, fillRange As Range, sceRange As Range, dltRange As Range


'set variables
Set inspectSht = Worksheets("inspections data")
Set worksSht = Worksheets("works data")
Set depositSht = Worksheets("deposits data")
Set safetySht = Worksheets("criticalsafety data")
Set wb = ThisWorkbook
stPath = Worksheets("Admin").Range("D16").Value
Set ob_FSO = CreateObject("Scripting.FileSystemObject")
Set ob_CheckFolder = ob_FSO.GetFolder(Worksheets("Admin").Range("D16").Value)
Set lookup = Worksheets("MATCH")


dlCount = 0
counter = 0


'find out how many files in folder
folderCheck = ob_CheckFolder.Files.Count


'ensure screen doesn't update and alerts are off
Application.ScreenUpdating = False
Application.DisplayAlerts = False


'''''''''''''''''''''''''''''''''''''''''''''''
'FIRST PART - this section looks for the files we have asked it to, and saves it to the selected folder as *subject text*.csv


'ensure the file path has a / at the end
If Right(stPath, 1) <> "\" Then stPath = stPath & "\"


    'set what subject lines the program is looking for
    depositFilter = "Deposits"
    safetyFilter = "criticalsafety"
    worksFilter = "Worksorders"
    inspectionsFilter = "inspections"
    
    'ensure there are no files in the folder being used, exits whole program if not
    If folderCheck = 0 Then


        'Get or create Outlook object and make sure it exists before continuing
        OutlookOpened = False
        On Error Resume Next
        Set outApp = GetObject(, "Outlook.Application")
        
        If Err.Number <> 0 Then
            Set outApp = New Outlook.Application
            OutlookOpened = True
        End If
        
        On Error GoTo 0
        
        If outApp Is Nothing Then
            MsgBox "Cannot start Outlook.", vbExclamation
            Exit Sub
        End If
        
        Set outNs = outApp.GetNamespace("MAPI")
        
        'USER SELECTS FOLDER
        Set outFolder = outNs.PickFolder
        
        'Loops through items in selected inbox looks for items with the subject names we have picked,
        'saves the file as the *subject text* + .csv -- also checks only 4 files downloaded
        If Not outFolder Is Nothing Then
            For Each outItem In outFolder.Items
                If outItem.Class = Outlook.OlObjectClass.olMail Then
                Set outMailItem = outItem
                If outMailItem.Subject = depositFilter Or outMailItem.Subject = safetyFilter _
                Or outMailItem.Subject = worksFilter Or outMailItem.Subject = inspectionsFilter Then
                    Debug.Print outMailItem.Subject
                    For Each outAttachment In outMailItem.Attachments
                        outAttachment.SaveAsFile stPath & outItem.Subject & ".csv"
                        dlCount = dlCount + 1
                    Next
        End If
    End If
             Next
End If


If OutlookOpened Then outApp.Quit


Set outApp = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'SECOND PART - at this point the files have been saved to the folder selected and now goes through them taking the necessary data


'check only 4 files downloaded
If dlCount = 4 Then


'clear all sheets
inspectSht.Cells.ClearContents
depositSht.Cells.ClearContents
worksSht.Cells.ClearContents
safetySht.Cells.ClearContents


'unhide all sheets
For Each sht In ActiveWorkbook.Worksheets


    sht.Visible = xlSheetVisible


Next sht


'loops through array of files
For Each ob_File In ob_CheckFolder.Files


Set ob_File = Workbooks.Open(ob_File.Path)
Set sht = Worksheets(1)


'get last row + colum to copy
Lastrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
lastCol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column


'range to copy is equal to current last row and column
Set cpyRange = sht.Range(sht.Cells(1, 1), sht.Cells(Lastrow, lastCol))


'copy the range
cpyRange.Copy


'if *name of file* is in the opened workbook name - paste to correct data sheet
If InStr(1, ActiveWorkbook.Name, "inspections") Then
    With wb
        With inspectSht
            'paste
            .Cells(1, 1).PasteSpecial xlPasteValues
            'find out where PMC Branch column is
            pmcCol = .Range("1:1").Find(What:="PMC_Branch", LookAt:=xlPart).Column
            branchCol = .Range("1:1").Find(What:="Property_Branch", LookAt:=xlPart).Column
            'get last row and column of currently opened sheet
            Lastrow = .Cells(inspectSht.Rows.Count, 1).End(xlUp).Row
            lastCol = .Cells(1, inspectSht.Columns.Count).End(xlToLeft).Column
            Set dltRange = Range(Cells(Lastrow, branchCol), Cells(2, branchCol))
            'delete any testing values
            With dltRange
                For dltctr = Lastrow To 2 Step -1
                    If InStr(1, dltRange(dltctr), "Testing") Then
                        dltRange(dltctr).EntireRow.Delete
                    End If
                    
                Next dltctr
            End With
            'add Region + formula headings + formula
            .Cells(1, lastCol).Offset(0, 1).Value = "Region"
            .Cells(1, lastCol).Offset(0, 2).Value = "Days"
            .Cells(1, lastCol).Offset(1, 2).Value = "=+IF(AND(A2>=30,A2<120),""1-4"",IF(AND(A2>=120,A2<240),""4-8"",IF(AND(A2>=240,A2>=365),""8-12"",IF(A2<365,""12+""))))"
            'close current workbook
            ob_File.Close SaveChanges:=False
            'autofill formula
            daysCol = .Range("1:1").Find(What:="Days", LookAt:=xlPart).Column
            Set sceRange = .Range("1:1").Find(What:="Days", LookAt:=xlPart).Offset(1, 0)
            Set fillRange = Range(inspectSht.Cells(2, daysCol), inspectSht.Cells(Lastrow, daysCol))
            sceRange.AutoFill Destination:=fillRange
            'add Region
            With Range(inspectSht.Cells(2, lastCol + 1), inspectSht.Cells(Lastrow, lastCol + 1))
                For ctr = Lastrow To 2 Step -1
                    matcher = inspectSht.Cells(ctr, pmcCol).Value
                    If Not matcher = "" Then
                        Set searchRange = Worksheets("MATCH").Range("A:A").Find(What:=matcher, LookAt:=xlPart)
                            If Not searchRange Is Nothing Then
                                inspectSht.Cells(ctr, lastCol + 1).Value = searchRange.Offset(0, 1).Value
                            End If
                    End If
                Next ctr
            End With
        End With
    End With
        counter = counter + 1


ElseIf InStr(1, ActiveWorkbook.Name, "Worksorders") Then
    With wb
        With worksSht
            'paste
            .Cells(1, 1).PasteSpecial xlPasteValues
            'find out where PMC column is
            pmcCol = .Range("1:1").Find(What:="PMC_Branch", LookAt:=xlPart).Column
            branchCol = .Range("1:1").Find(What:="Property_Branch", LookAt:=xlPart).Column
            'get last row and column of currently opened sheet
            Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            Set dltRange = Range(Cells(Lastrow, branchCol), Cells(2, branchCol))
        
            
            'delete any testing values
            With dltRange
                For dltctr = Lastrow To 2 Step -1
                If InStr(LCase(dltRange(dltctr).Value), "testing") <> 0 Then
                    
                        dltRange(dltctr).EntireRow.Delete Shift:=xlUp
                    End If
                    
                Next dltctr
             End With
            'add Region + formula headings + formula
            .Cells(1, lastCol).Offset(0, 1).Value = "Region"
            .Cells(1, lastCol).Offset(0, 2).Value = "Days"
            .Cells(1, lastCol).Offset(1, 2).Value = "=+IF(AND(A2>=35,A2<45),""35-44"",IF(AND(A2>=45,A2<60),""45-59"",IF(A2>=60,""60+"")))"
            'close current workbook
            ob_File.Close SaveChanges:=False
            'autofill formula
            daysCol = .Range("1:1").Find(What:="Days", LookAt:=xlPart).Column
            Set sceRange = .Range("1:1").Find(What:="Days", LookAt:=xlPart).Offset(1, 0)
            Set fillRange = Range(worksSht.Cells(2, daysCol), worksSht.Cells(Lastrow, daysCol))
            sceRange.AutoFill Destination:=fillRange
            'add regions
            With Range(worksSht.Cells(2, lastCol + 1), worksSht.Cells(Lastrow, lastCol + 1))
                For ctr = Lastrow To 2 Step -1
                    matcher = worksSht.Cells(ctr, pmcCol).Value
                    If Not matcher = "" Then
                    Set searchRange = Worksheets("MATCH").Range("A:A").Find(What:=matcher, LookAt:=xlPart)
                        If Not searchRange Is Nothing Then
                            worksSht.Cells(ctr, lastCol + 1).Value = searchRange.Offset(0, 1).Value
                        End If
                    End If
                Next ctr
            End With
        End With
    
    End With
counter = counter + 1


ElseIf InStr(1, ActiveWorkbook.Name, "Deposits") Then
    With wb
        With depositSht
            'paste
            .Cells(1, 1).PasteSpecial xlPasteValues
            'find out which column holds PMC Branch
            pmcCol = .Range("1:1").Find(What:="PMC_Branch", LookAt:=xlPart).Column
            branchCol = .Range("1:1").Find(What:="Property_Branch", LookAt:=xlPart).Column
            'get last row and column of currently opened sheet
            Lastrow = .Cells(depositSht.Rows.Count, 1).End(xlUp).Row
            lastCol = .Cells(1, depositSht.Columns.Count).End(xlToLeft).Column
            Set dltRange = Range(Cells(Lastrow, branchCol), Cells(2, branchCol))
            'delete any testing values
            With dltRange
                For dltctr = Lastrow To 2 Step -1
                    If InStr(1, dltRange(dltctr), "Testing") Then
                        dltRange(dltctr).EntireRow.Delete
                    End If
                    
                Next dltctr
             End With
            'add Region + formula headings + formula
            .Cells(1, lastCol).Offset(0, 1).Value = "Region"
            .Cells(1, lastCol).Offset(0, 2).Value = "Days"
            .Cells(1, lastCol).Offset(1, 2).Value = "=+IF(AND(A2>=30,A2<60),""30+"",IF(AND(A2>=60,A2<90),""60+"",IF(A2>=90,""90+"")))"
            'close current workbook
            ob_File.Close SaveChanges:=False
            'autofill formula
            daysCol = .Range("1:1").Find(What:="Days", LookAt:=xlPart).Column
            Set sceRange = .Range("1:1").Find(What:="Days", LookAt:=xlPart).Offset(1, 0)
            Set fillRange = Range(depositSht.Cells(2, daysCol), depositSht.Cells(Lastrow, daysCol))
            sceRange.AutoFill Destination:=fillRange
            'add regions
                With Range(depositSht.Cells(2, lastCol + 1), depositSht.Cells(Lastrow, lastCol + 1))
                    For ctr = Lastrow To 2 Step -1
                        matcher = depositSht.Cells(ctr, pmcCol).Value
                        If Not matcher = "" Then
                        Set searchRange = Worksheets("MATCH").Range("A:A").Find(What:=matcher, LookAt:=xlPart)
                            If Not searchRange Is Nothing Then
                                depositSht.Cells(ctr, lastCol + 1).Value = searchRange.Offset(0, 1).Value
                            End If
                        End If
                    Next ctr
                
                End With
        End With
        
    End With
counter = counter + 1


ElseIf InStr(1, ActiveWorkbook.Name, "criticalsafety") Then
    With wb
        With safetySht
            'paste
            .Cells(1, 1).PasteSpecial xlPasteValues
            'find out where PMC Branch column is
            pmcCol = .Range("1:1").Find(What:="PMC_Branch", LookAt:=xlPart).Column
            branchCol = .Range("1:1").Find(What:="Property_Branch", LookAt:=xlPart).Column
            'get last row and column of currently opened sheet
            Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            Set dltRange = Range(Cells(Lastrow, branchCol), Cells(2, branchCol))
            'delete any testing values
            With dltRange
                For dltctr = Lastrow To 2 Step -1
                    If InStr(1, dltRange(dltctr), "Testing") Then
                        dltRange(dltctr).EntireRow.Delete
                    End If
                    
                Next dltctr
            End With
            'add Region + formula headings + formula
            .Cells(1, lastCol).Offset(0, 1).Value = "Region"
            .Cells(1, lastCol).Offset(0, 2).Value = "Days"
            .Cells(1, lastCol).Offset(1, 2).Value = "=+IF(AND(A2>=1,A2<5),""1-4"",IF(AND(A2>=5,A2<10),""5-9"",IF(A2>=10,""10+"")))"
            'close current workbook
            ob_File.Close SaveChanges:=False
            'autofill formula
            daysCol = .Range("1:1").Find(What:="Days", LookAt:=xlPart).Column
            Set sceRange = .Range("1:1").Find(What:="Days", LookAt:=xlPart).Offset(1, 0)
            Set fillRange = Range(safetySht.Cells(2, daysCol), safetySht.Cells(Lastrow, daysCol))
            sceRange.AutoFill Destination:=fillRange
            'add regions
                With Range(safetySht.Cells(2, lastCol + 1), safetySht.Cells(Lastrow, lastCol + 1))
                    For ctr = Lastrow To 2 Step -1
                    matcher = safetySht.Cells(ctr, pmcCol).Value
                        If Not matcher = "" Then
                        Set searchRange = Worksheets("MATCH").Range("A:A").Find(What:=matcher, LookAt:=xlPart)
                            If Not searchRange Is Nothing Then
                             safetySht.Cells(ctr, lastCol + 1).Value = searchRange.Offset(0, 1).Value
                            End If
                        End If
                    Next ctr
                End With
        End With
    
    End With
counter = counter + 1
End If


'next worksheet
Next


'exit the program if more or less than 4 files downloaded to folder and tell user whats happened
Else
    MsgBox "Wrong amount of files downloaded from inbox! Please check inbox and ensure only the 4 most recent e-mails are in there."
    Exit Sub
End If


'exit the program if the folder to save in is not empty and tell user whats happened
Else
    MsgBox "Folder to save files is not empty! Please delete any files in this folder and run again"
    Exit Sub
End If


'call updatePivots sub
AdjustPivotDataRange


'refresh all pivot tables
For Each ws In wb.Worksheets
    'calculate on sheets in case autocalc is off
    ws.Calculate
        If ws.PivotTables.Count > 0 Then
            For Each pt In ws.PivotTables
                pt.RefreshTable
            Next pt
        End If
Next ws


'turn screen updating and alerts back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True


'select Dash sheet which will also hide all the sheets
Worksheets("Dash").Activate


'tell user how many sheets updated
MsgBox counter & "/4 sheets updated! If all sheets have not updated, please check e-mails."


End Sub
 
Upvote 0
Depending on what sheet you're looking at you're looking for Testing in 2 different ways. If this method works, try using it in stead of the version that doesn't work
Code: 
            With dltRange
                For dltctr = Lastrow To 2 Step -1
                    If InStr(1, dltRange(dltctr), "Testing") Then
                        dltRange(dltctr).EntireRow.Delete
                    End If
                    
                Next dltctr
 
Upvote 0
Nevermind! Found it. Just needed to reference the sheet on the below line.. whoops

Code: 
Set dltRange = Range(worksSht.Cells(Lastrow, branchCol), worksSht.Cells(2, branchCol))

When i testedtit before with .address it gave me M:M and i just assumed it was on the correct sheet.

Thanks for your help anyway!
 
Upvote 0
Glad you sorted it out, thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Solved
Need help to update Macro
Replies
3
Views
46
Anthony47
A
J
  • Question Question
Formatting error when switching from Mac to PC
Replies
6
Views
115
RoryA
RoryA
C
  • Question Question
Using pattern searches with a variable to find the correct values
2
Replies
10
Views
266
chazrab
C
H
  • Question Question
Copy Data where Source Workbook contains Name that is in destination sheet
Replies
4
Views
212
howard
H
T
  • Solved
Search for text and highlight row
Replies
5
Views
307
Joe4
Joe4

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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