Search several columns string in a worksheet

[rafdepet]

Hi there,

I would like to search (to check) if in a different workbook.worksheet there are columns with header title:

the user creates a worksheet with 10 columns, I have to retrieve some data from it, but they usually forget to create the columns which are mandatory for my retrieval.

The code looks for those columns title(see the list) and when matched retrieves the data.

I know how to look into the sheet to match if are present but I'd like to keep in a variant the missing ones and show in a msgbox to the user, so they know that the file can't be retrieved if one ore more columns are not present.

columns needed are:

Amount
Outlet Name
Document Date
Document number
Company

I can of course send a msgbox to the user every column missed, but I need to have a list of missing in the same msgbox

Thanks for your help
Raf

 

[tlowry]

Welcome to MrExcel!

I think this will do what you asked for:

This uses a Dictionary. If you have problems running this code, you may have to update the references.

For a complete discussion on the Dictionary see:

VBA for smarties: Dictionaries

Sub AreTheyThere()
    Dim lookfor, i, cCell
    lookfor = Array("Amount", "Outlet Name", "Document Date", "Document number", "Company")
    Dim dict: Set dict = CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(lookfor)
        dict.Add lookfor(i), 1
    Next i
    For Each cCell In Application.Intersect(Rows(1), ActiveSheet.UsedRange)
        If dict.exists(cCell.Text) Then dict.Remove (cCell.Text)
        If UBound(dict.keys) = -1 Then Exit Sub
    Next
    MsgBox "Not found: " & vbCrLf & Join(dict.keys, vbCrLf)
End Sub

 

[rafdepet]

Welcome to MrExcel!

I think this will do what you asked for:

This uses a Dictionary. If you have problems running this code, you may have to update the references.

For a complete discussion on the Dictionary see:

VBA for smarties: Dictionaries

Sub AreTheyThere()
    Dim lookfor, i, cCell
    lookfor = Array("Amount", "Outlet Name", "Document Date", "Document number", "Company")
    Dim dict: Set dict = CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(lookfor)
        dict.Add lookfor(i), 1
    Next i
    For Each cCell In Application.Intersect(Rows(1), ActiveSheet.UsedRange)
        If dict.exists(cCell.Text) Then dict.Remove (cCell.Text)
        If UBound(dict.keys) = -1 Then Exit Sub
    Next
    MsgBox "Not found: " & vbCrLf & Join(dict.keys, vbCrLf)
End Sub

Great tlowry

it worked, by the way is there any possibilities to use wild cards as * or ? to be sure the match can't fail only for a dot(.) or a spacebar carachter.

Anyhow thanks for spectacular solution

Raf

 

[tlowry]

by the way is there any possibilities to use wild cards as * or ? to be sure the match can't fail only for a dot(.) or a spacebar carachter.

To quote Mark Twain: “It’s easier to stay out than to get out.”

In this case, it applies to not allowing the Excel file to be submitted if it does not have columns with headers that are exact matches.

Allowing wildcards (aka fuzzy logic) is a can of fuzzy worms.

To start, run “AreTheyThere” when the workbook is closed. Put the following in “ThisWorkbook” module. This will popup a message if columns are missing.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    AreTheyThere
End Sub

With a bit of work, we can not allow a submit process without the proper columns.

 

[rafdepet]

To quote Mark Twain: “It’s easier to stay out than to get out.”

In this case, it applies to not allowing the Excel file to be submitted if it does not have columns with headers that are exact matches.

Allowing wildcards (aka fuzzy logic) is a can of fuzzy worms.

To start, run “AreTheyThere” when the workbook is closed. Put the following in “ThisWorkbook” module. This will popup a message if columns are missing.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    AreTheyThere
End Sub

With a bit of work, we can not allow a submit process without the proper columns.

Dear and Great tlowry

I want to be involved, but (in Italy we use to say this "I know my chickens") means that I am getting in touch with users which are not so smart with excel, and they think that pushing a button everything works.
And despite their very clever performance with trade markets, they are only sellers and not technically so prepared. That's why someone who's taking care of them (on this matter), they'll find it.

By the way I thought about some functions like this: (it seems to be working)


Code:
#Function normalize(ByVal cella As String) As StringIf (Left(cella, 6) = "Outlet") Then
#normalize = "Outlet Name"
#Exit Function
#End If
#normalize= cella
#End Function


your code:

#Sub AreTheyThere()
#Dim lookfor, i, cCell
#lookfor = Array("Amount", "Outlet Name", "Document Date", "Document number", "Company")
#Dim dict: Set dict = CreateObject("Scripting.Dictionary")0
#For i = 0 To UBound(lookfor)
#dict.Add lookfor(i), 1
#Next i
#For Each cCell In Application.Intersect(Rows(1), ActiveSheet.UsedRange)
#If dict.exists(normalize(cCell.Text)) Then dict.Remove (normalize(cCell.Text))
#If UBound(dict.keys) = -1 Then Exit Sub
#Next
#MsgBox "Not found: " & vbCrLf & Join(dict.keys, vbCrLf)
#End Sub


what do you think about?

Again, thanks for helping

 

[tlowry]

Ok, so herding cats is a tough gig.

The following code adds “fuzzy” logic to finding column headings. It also puts the “found” headings in the header row. Look at

[B][I]Function GetFuzzy(sText) As String[/I][/B]

to see how the logic works

Sub AreTheyThere()
    Dim lookfor, i, cCell, shold
    lookfor = Array("Amount", "Outlet Name", "Document Date", "Document number", "Company")
    Dim dict: Set dict = CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(lookfor)
        dict.Add UCase(GetFuzzy(lookfor(i))), lookfor(i)
    Next i
    For Each cCell In Application.Intersect(Rows(1), ActiveSheet.UsedRange)
        shold = GetFuzzy(cCell.Text)
        If shold <> "" And dict.exists(shold) Then
            cCell.Value = dict.Item(shold)              ' Change col heading to what Fuzzy thinks it is
            dict.Remove (shold)
        End If
        If UBound(dict.keys) = -1 Then Exit Sub
    Next
    MsgBox "Not found: " & vbCrLf & Join(dict.items, vbCrLf)
End Sub
Function GetFuzzy(sText) As String
    Dim shold
    GetFuzzy = ""
    shold = UCase(sText)
    If shold Like ("*NUM*") Then shold = "Document Number"
    If shold Like ("*OUTLET*") Then shold = "Outlet Name"
    If shold Like ("*DATE*") Then shold = "Document Date"
    If shold Like ("*AMT*") Then shold = "Amount"
    shold = Trim(UCase(shold))
    GetFuzzy = shold
End Function