VBA Coding and LISTBOX Coding to Dialogue with Each Other

Question

To Whom It May Concern:

I was given an assignment by my manager to write a VBA program, using Excel 2013 on Window 8.1 to interrogate a file's content to determine what is on it and then format it in a specific company format. Above it is a sample of what is contained on the file.

From this, the user uses the below listboxes to tell what is in each field.

The textbox tells the user what the next field in the file it seeks information on. In order to accomplish this task, there has to be a dialogue between the main module and the listbox routine if the program is to work correctly. The problem I am having is when the user selects (or click on “ADD”) for the first field in the file, the program performs the code for the ADD togglebutton and then stops (See below). It doesn’t continue the processing so the user can tell the system what the next field in the file is. What do I need to do to have the system to continue processing after the user makes his first selection? The code that I am using is below to create the dialogue MAIN routine and LISTBOX routine. I trust that I was descriptive enough. I apologize if I wasn’t.

MAIN ROUTINE:

blnCancel = False

blnOK = False

R = 1

C = R

Call FieldSel.GetColumnCategory(C, intColumnCategory, blnGetColumnCategory, _

                                                            blnError, strColumn)

Do '*** Determine type of column or field data present in input file***

      blnAdd = False

     blnRemoved = False

     If R = 1 Then

         FieldSel.Show

    End If

    If blnGetColumnCategory = True Then

       If blnAdd = True Then

          If blnError = False Then '***Check to if chart is empty

             'Call Field_Movement(intColumnCategory)

              arrColumns(lngRows, (intColumnCategory - 1)) = intColumnCategory

              R = R + 1

              C = R

              Call FieldSel.GetColumnCategory(C, intColumnCategory, blnGetColumnCategory, _

                                                                         blnError, strColumn)

          End If

      ElseIf blnRemoved = True Then

                arrColumns(lngRows, (intColumnCategory - 1)) = "99"

                Call FieldSel.GetColumnCategory(C, intColumnCategory, blnGetColumnCategory, _

                                                                            blnError, strColumn)

           End If

    End If

Loop While blnCancel = False And blnOK = False

 ReDim Preserve arrColumns(lngRows, intCols)

LISTBOX ROUTINE:

Option Explicit

Public Sub GetColumnCategory(ByRef C As Integer, ByRef intColumnCategory As Integer, _

                              ByRef blnGetColumnCategory As Boolean, blnError As Boolean, _

                              ByRef strColumn As String)

   On Error GoTo GetColumnCategory_ErrorHandler

   blnGetColumnCategory = False

   blnError = False

   Select Case C

          Case 1

               strColumn = "A"

          Case 2

               strColumn = "B"

          Case 3

               strColumn = "C"

          Case 4

               strColumn = "D"

          Case 5

               strColumn = "E"

          Case 6

               strColumn = "F"

          Case 7

               strColumn = "G"

          Case 8

               strColumn = "H"

          Case 9

               strColumn = "I"

          Case 10

               strColumn = "J"

          Case 11

               strColumn = "K"

          Case 12

               strColumn = "L"

          Case 13

               strColumn = "M"

          Case 14

               strColumn = "N"

          Case 15

               strColumn = "O"

          Case 16

               strColumn = "P"

          Case 17

               strColumn = "Q"

          Case 18

               strColumn = "R"

          Case 19

               strColumn = "S"

          Case 20

               strColumn = "T"

          Case 21

               strColumn = "U"

          Case 22

               strColumn = "V"

          Case 23

               strColumn = "W"

          Case 24

               strColumn = "X"

          Case 25

               strColumn = "Y"

          Case 26

               strColumn = "Z"

          Case 27

               strColumn = "AA"

          Case 28

               strColumn = "AB"

          Case 29

               strColumn = "AC"

          Case 30

               strColumn = "AD"

          Case 31

               strColumn = "AE"

          Case 32

               strColumn = "AF"

          Case 33

               strColumn = "AG"

          Case 34

               strColumn = "AH"

          Case 35

               strColumn = "AI"

          Case 36

               strColumn = "AJ"

          Case 37

               strColumn = "AK"

          Case 38

               strColumn = "AL"

          Case 39

               strColumn = "AM"

          Case 40

               strColumn = "AN"

          Case 41

               strColumn = "AO"

          Case 42

               strColumn = "AP"

          Case 43

               strColumn = "AQ"

          Case 44

               strColumn = "AR"

          Case 45

               strColumn = "AS"

          Case 46

               strColumn = "AT"

          Case 47

               strColumn = "AU"

          Case 48

               strColumn = "AV"

          Case 49

               strColumn = "AW"

          Case 50

               strColumn = "AX"

          Case 51

               strColumn = "AY"

          Case 52

               strColumn = "AZ"

          Case Else

               blnError = True

   End Select

   FieldSel.FieldSel_txbMessage.Value = "Please select the data category for column: " & strColumn

   Call UserForm2_Initialize

   blnGetColumnCategory = True

GetColumnCategory_Function_Exit:

   Exit Sub

GetColumnCategory_ErrorHandler:

   If blnError = True Then

      MsgBox "GetColumnCategory: An empty chart was encounted."

   Else

      MsgBox "GetColumnCategory: An error code " & _

             "(" & Err.Number & " -- " & Err.Description & ", " & _

             Err.Source & ") has occurred while " & _

             "determining column category."

   End If

   Resume GetColumnCategory_Function_Exit

   Resume

End Sub

Private Sub UserForm2_Initialize()

   With Me.FieldSel_lbxSelect

       .RowSource = ""

       .AddItem """1"" - Salutation"

       .AddItem """2"" - Title"

       .AddItem """3"" - Full Name"

       .AddItem """4"" - First Name"

       .AddItem """5"" - Middle Name or Initial"

       .AddItem """6"" - Last Name"

       .AddItem """7"" - Surname"

       .AddItem """8"" - Address 1"

       .AddItem """9"" - Address 2"

       .AddItem """10"" - City"

       .AddItem """11"" - County"

       .AddItem """12"" - State"

       .AddItem """13"" - Zip Code"

       .AddItem """14"" - Area"

       .AddItem """15"" - Country"

       .AddItem """16"" - E-Mail"

       .AddItem """17"" - Company"

       .AddItem """18"" - Phone country code"

       .AddItem """19"" - Phone area code"

       .AddItem """20"" - Phone number"

       .AddItem """21"" - Fax country code"

       .AddItem """22"" - Fax area code"

       .AddItem """23"" - Fax number"

       .AddItem """24"" - Mobile country code"

       .AddItem """25"" - Mobile area code"

       .AddItem """26"" - Mobile number"

       .AddItem """27"" - Messenger"

       .AddItem """28"" - Homepage"

       .AddItem """29"" - Social Networks"

       .AddItem """30"" - Birthday"

       .AddItem """31"" - Notes"

       .AddItem """32"" - Origin"

       .AddItem """33"" - Campaign"

       .AddItem """34"" - IP address"

       .AddItem """99"" - Extraneous Data"

   End With

   FieldSel.Show

End Sub

Private Sub FieldSel_TgbAdd_Click()

   If FieldSel.FieldSel_lbxSelect.ListIndex = -1 Then

      Exit Sub

   End If

   For I = 0 To FieldSel.FieldSel_lbxSelected.ListCount - 1

       If FieldSel.FieldSel_lbxSelect.Value = FieldSel.FieldSel_lbxSelected.List(I) Then

          Exit Sub

       End If

   Next I

   module1.intColumnCategory = FieldSel.FieldSel_lbxSelect.ListIndex + 1

   FieldSel.FieldSel_lbxSelected.AddItem FieldSel.FieldSel_lbxSelect.Value

   module1.blnAdd = True

End Sub ****The processing gets to point and then stops for no apparent reason on my part. I want processing to continue so it will go back to the MAIN ROUTINE.****

Private Sub FieldSel_TgbRemove_Click()

   If FieldSel.FieldSel_lbxSelected.ListIndex <> -1 Then

      FieldSel.FieldSel_lbxSelected.RemoveItem FieldSel.FieldSel_lbxSelected.ListIndex

      module1.C = FieldSel.FieldSel_lbxSelected.ListIndex - 1

      module1.blnRemoved = True

   End If

   If FieldSel.FieldSel_lbxSelected.ListIndex = -1 Then

      FieldSel.FieldSel_lbxSelected.Enabled = False

   End If

End Sub

Private Sub FieldSel_lbxSelect_Enter()

   FieldSel_tgbRemove.Enabled = False

End Sub

Private Sub FieldSel_lbxSelected_Enter()

   FieldSel_tgbRemove.Enabled = True

End Sub

Private Sub FieldSel_cmbCancel_Click()

   Unload FieldSel

   module1.blnCancel = True

End Sub

Private Sub FieldSel_cmbOK_Click()

   Unload FieldSel

   module1.blnOK = True

End Sub

Private Sub FieldSel_scbSelect_Change()

   ActiveWindow.ScrollColumn = FieldSel_scbSelect.Value

End Sub

Private Sub FieldSel_scbSelected_Change()

   ActiveWindow.ScrollColumn = FieldSel_scbSelected.Value

End Sub

---

I would like to thank you in advance for help in resolving this matter. I have been agonizing over this issue for a week now without coming up with any answers.

Melvin Gardner

Answer 1

I'm not sure what you are doing or what you actually need - often it is better to describe what you want rather than what you have  - your code doesn't work, requires specific worksheets and ranges and named objects, etc. making it hard to duplicate your workbook.

Anyway, you could use VBA to add a new row 1 for titles, with DV to create the list of options for those cells, and CF to highlight any duplicates.

With the first sheet you show as the activesheet, try this code, then select the values for the new row 1.

Sub AddTitlesToColumns()

    Dim v As Variant

    Dim sh As Worksheet

    Dim shD As Worksheet

    Set shD = ActiveSheet

    shD.Range("1:1").EntireRow.Insert

    v = Array("Salutation", "Title", "Full Name", "First Name", "Middle Name or Initial", _

    "Last Name", "Surname", "Address 1", "Address 2", "City", "County", "State", _

    "Zip Code", "Area", "Country", "E-Mail", "Company", "Phone country code", _

    "Phone area code", "Phone number", "Fax country code", "Fax area code", _

    "Fax number", "Mobile country code", "Mobile area code", "Mobile number", _

    "Messenger", "Homepage", "Social Networks", "Birthday", "Notes", "Origin", _

    "Campaign", "IP address", "Extraneous Data")

    Set sh = Sheets.Add(After:=Sheets(Sheets.Count))

    sh.Range("A1").Resize(UBound(v) + 1, 1).Value = Application.Transpose(v)

    ActiveWorkbook.Names.Add Name:="List", RefersToR1C1:= _

    "=" & sh.Range("A1").CurrentRegion.Address(True, True, xlR1C1)

    With shD.Range("1:1").Validation

        .Delete

        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

        xlBetween, Formula1:="=List"

    End With

    With shD.Range("1:1")

        .FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF($A$1:A1,A1)>1"

        .FormatConditions(.FormatConditions.Count).SetFirstPriority

        .FormatConditions(1).Interior.Color = 255

    End With

End Sub