Solved: Several issues with my code

[mae0429]

Hi, I'm new to the forum and I'm looking for some help. I have a decent background in other programming languages but am new to VBA. I've done alright so far, but now I'm stuck.

I need help splitting up a string that is passed to a function. This string comes from a listbox. Then, the split up parts must be put into an array (or something) and then those individual strings need to be searched for on the worksheet. When the cell is found, it needs to be added to a range that gets returned from the function.

Here is my code so far:

 
Private Sub EnterButton_Click()
' Call header selecting function
    myHeadings = SelectHeadings
    Unload Me
 
' Call range finder function
    HeaderRange = FindHeader(myHeadings)
 
End Sub
 
 
Function SelectHeadings() As String
    Dim lItem As Long
    Dim headings As String
    For lItem = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(lItem) = True Then
            headings = headings & ListBox1.List(lItem) & ","
            ListBox1.Selected(lItem) = False
        End If
    Next
    headings = Left(headings, Len(headings) - 1)
    SelectHeadings = headings
    MsgBox ("Your selections have been saved!")
End Function
 
 
Function FindHeader(headerStr) As Range
' Split up header string
    Dim s() As String
    Dim i As Integer
 
    s = Split(headerStr, ",")
    For i = 0 To UBound(s)
        s(i) = Trim(s(i)) & ","
    Next
' Loop through string array finding corresponding cells
    Dim foundRange() As Range
    With Worksheets(1)
        For i = 0 To UBound(s)
            Set c = .Find(s(i), LookIn:=xlValues)
            foundRange(i) = c
        Next i
    End With
    FindHeader = foundRange
End Function

[Bob Phillips]

Not tested, but this looks about right

[vba]


Function FindHeader(headerStr) As Range
' Split up header string
Dim s() As String
Dim i As Long

s = Split(headerStr, ",")
For i = LBound(s) To UBound(s)
s(i) = Trim(s(i)) & ","
Next
' Loop through string array finding corresponding cells
Dim foundRange As Range
With Worksheets(1).Cells
For i = LBound(s) To UBound(s)
Set c = .Find(s(i), LookIn:=xlValues)
If Not c Is Nothing Then

If foundRange Is Nothing Then

Set foundRange = c
Else

Set foundRange = Union(foundRange, c)
End If
End If
Next i
End With
FindHeader = foundRange
End Function
[/vba]

[mae0429]

First of all, thank you for the help! However, I replaced the code and was met with "Run-time error '91': Object variable or With block variable not set" and when I click Debug, it highlights the "HeaderRange = FindHeader(myHeadings)" line. Any further suggestion as to what went wrong?

[mdmackillop]

try
[VBA]
Set FindHeader = foundRange

[/VBA]

[mae0429]

Still no luck

Let me start at the beginning and maybe that will put it more in perspective (or there could be an easier way to do what I'm trying to do).

I'm looking to automate a very tedious manual process that needs to have versatility in choosing certain columns of data. The data comes in a .txt file and is separated by vertical bars (|). It needs to be imported to excel, then certain columns must be selected, then it should be cleaned up (borders, bold text, etc.) I decided to create a user form that has three buttons: Import, Select and Format, and Close.

Here is the module that starts us off:
[vba]
Sub Produce_CAPA_Status_Report()
'
' Button Form macro
ButtonForm.Show
End Sub
[/vba]

Then, here is the code on that form:
[vba]
Private Sub CloseButton_Click()
' Close dialog box
Unload Me
End Sub

Private Sub ImportButton_Click()
' Call import function
ImportTxt
End Sub

Private Sub ListButton_Click()
' Open listbox
ListForm.Show
End Sub

Function ImportTxt()
'Get file to import and delimit it appropriately
fileLookup = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")
Dim fileToOpen As String
fileToOpen = "TEXT;" & fileLookup
With ActiveSheet.QueryTables.Add(Connection:=fileToOpen, Destination:=Range("A1"))
.Name = "RawData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Function
Function HeaderRange() As Range
' Get the number of headings
nextcounter = 0
For i = 1 To 10
counter = 0
For j = 1 To 100
cellCheck = Cells(i, j)
If Not cellCheck = "" Then
counter = counter + 1
Else
Exit For
End If
Next j
If counter > nextcounter Then
nextcounter = counter
End If
Next i

' Get the starting row number
For k = 1 To 100
cellStart = Cells(k, 2)
If Not cellStart = "" Then
startRow = k
Exit For
End If
Next k
Range(Cells(startRow, 1), Cells(startRow, nextcounter)).Name = "MyRange"
HeaderRange = "MyRange"
End Function
[/vba]

Next, when it calls the list form (which consists of a listbox and an enter button), we get the following:
[vba]
Private Sub EnterButton_Click()
' Call header selecting function
myHeadings = SelectHeadings
Unload Me

' Call range finder function
HeaderRange = FindHeader(myHeadings)
' Format report
FormatStatusReport (HeaderRange)

End Sub

Private Sub UserForm_Initialize()
Dim rCell As Range
With ListBox1
For Each rCell In Range("MyRange")
Dim cellname As String
cellname = rCell.Value
ListBox1.AddItem cellname
Next rCell
End With
End Sub

Function SelectHeadings() As String
Dim lItem As Long
Dim headings As String
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
headings = headings & ListBox1.List(lItem) & ","
ListBox1.Selected(lItem) = False
End If
Next
headings = Left(headings, Len(headings) - 1)
SelectHeadings = headings
MsgBox ("Your selections have been saved!")
End Function

Function FindHeader(headerStr) As Range
' Split up header string
Dim s() As String
Dim i As Long

s = Split(headerStr, ",")
For i = LBound(s) To UBound(s)
s(i) = Trim(s(i)) & ","
Next
' Loop through string array finding corresponding cells
Dim foundRange As Range
With Worksheets(1).Cells
For i = LBound(s) To UBound(s)
Set c = .Find(s(i), LookIn:=xlValues)
If Not c Is Nothing Then

If foundRange Is Nothing Then

Set foundRange = c
Else

Set foundRange = Union(foundRange, c)
End If
End If
Next i
End With
Set FindHeader = foundRange
End Function

Function FormatStatusReport(myCells As Range)
' Formatting code goes here
End Function
[/vba]

[Bob Phillips]

Got a sample text file as well?

[mae0429]

Sorry, here's a sample text file.

[mdmackillop]

Functions moved to Module
Comma deleted from s(i) values

[mae0429]

For some reason, it still didn't work, but when I removed it from being a function and just stuck it in my list form code under the commandbutton_click() sub, it worked.

Thank you all for your help!

[mdmackillop]

Glad it worked out. For some reason, the Function would not run on the UserForm, which is why I moved it.