Script to check text for string ".jpg"

[ctinmotion]

I have templates that I use to build a database for importing in to DB2. Before we send the data over, we need to run a script which checks the data in certain columns (L, M, N) to make sure that it contains the text ".jpg". Is there a quick and easy macro I can set up so I can run it on all of my templates?

TIA!

 

[SteveO59L]

You dont need to use code. Use find(), or search() in a formula

 

[ctinmotion]

Yeah, I thought about doing that but I have a total of 430 templates to search through. I was thinking it would be easier to just create a macro and be able to open the template and hit a function key to run the macro instead of having to create the formula on each one. I might be thinking wrong though, I'm a novice at this stuff, at best!

 

[Krishnakumar]

Hi,

This would give you a TRUE or FALSE.

With Application.WorksheetFunction
    MsgBox .CountIf(Application.Intersect(ActiveSheet.UsedRange, Columns("l:n")), "*.jpg") = _
        .CountA(Application.Intersect(ActiveSheet.UsedRange, Columns("l:n")))
End With

if you have column header then

replace the countif with the following

.CountIf(Application.Intersect(ActiveSheet.UsedRange, Columns("l:n")), "*.jpg")-3

HTH

 

[ctinmotion]

Also, I'm more worried about the cells that don't have the ".jpg" in them, moreso than the ones that do. These represent catalog images that will be displayed on our website. In our last load we found images that were not displaying although we uploaded the image files. After some digging we realized that the image name for the images in question was in the template as "Starret1jpg" instead of "Starret1.jpg" which is what the image name was. As a result, DB2 did not match the two and the image isn't being displayed on the web. I need to do a complete search on all 430 templates to find the cells that do not have the dot in the ".jpg".

 

[SteveO59L]

Are all of the templates in the same workbook?

 

[ctinmotion]

No, they are all separate workbooks. That's why I thought I'd just try to create a script, send it to the team, save it in our personal folders, then we could each take a 100 templates, open them up, run the macro, and check to make sure the ".jpg" was in there. I'm not sure if there is a "less manual' way to do it unfortunately

 

[Krishnakumar]

Hi,

Try this. Untested.

Sub kTest()

Dim strFolder       As String
Dim strFileName     As String
Dim wbkTemplate     As Workbook
Dim wbkActive       As Workbook
Dim k, i As Long, c As Long

With Application.FileDialog(4)
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    strFolder = .SelectedItems(1)
End With

Const ColumnHeaderIsThere   As Boolean = True '<<=== set false if no header


Set wbkActive = ThisWorkbook
strFileName = Dir(strFolder & "\*.xls*")

Do While Len(strFileName)
    Set wbkTemplate = Workbooks.Open(strFolder & "\" & strFileName)
    With Application.Intersect(ActiveSheet.UsedRange, Columns("l:n"))
        k = .Value2
        For i = 1 + IIf(ColumnHeaderIsThere, 1, 0) To UBound(k, 1)
            For c = 1 To UBound(k, 2)
                If InStr(1, k(i, c), ".jpg") = 0 Then
                    If LCase$(Right$(k(i, c), 3)) = "jpg" Then
                        k(i, c) = Replace(LCase$(k(i, c)), "jpg", ".jpg")
                    Else
                        k(i, c) = k(i, c) & ".jpg"
                    End If
                End If
            Next
        Next
        .Value2 = k
    End With
    strFileName = Dir()
Loop

End Sub

HTH

 

[SleepyBear]

Don't know if this is relevant, but could you program a Macro (and shortcut!) to:

a) highlight all text with ".jpg" in, then
b) filter on those not highlighted.

Running the macro would then be a 2 second job per sheet?

 

[Krishnakumar]

Hi,

Ignore earlier code. Try this one.

Sub kTest()

Dim strFolder       As String
Dim strFileName     As String
Dim wbkTemplate     As Workbook
Dim wbkActive       As Workbook
Dim k, i As Long, c As Long

With Application.FileDialog(4)
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    strFolder = .SelectedItems(1)
End With

Const ColumnHeaderIsThere   As Boolean = True '<<=== set false if no header

With Application
    .ScreenUpdating = 0
    .DisplayAlerts = 0
End With

Set wbkActive = ThisWorkbook
strFileName = Dir(strFolder & "\*.xls*")

Do While Len(strFileName)
    Set wbkTemplate = Workbooks.Open(strFolder & "\" & strFileName)
    With Application.Intersect(ActiveSheet.UsedRange, Columns("l:n"))
        k = .Value2
        For i = 1 + IIf(ColumnHeaderIsThere, 1, 0) To UBound(k, 1)
            For c = 1 To UBound(k, 2)
                If InStr(1, k(i, c), ".jpg",1) = 0 Then
                    If LCase$(Right$(k(i, c), 3)) = "jpg" Then
                        k(i, c) = Replace(LCase$(k(i, c)), "jpg", ".jpg")
                    Else
                        k(i, c) = k(i, c) & ".jpg"
                    End If
                End If
            Next
        Next
        .Value2 = k
    End With
    wbkTemplate.Close 1
    Set wbkTemplate = Nothing
    strFileName = Dir()
Loop

With Application
    .ScreenUpdating = 1
    .DisplayAlerts = 1
End With

End Sub