• Status: Solved
  • Priority: Medium
  • Security: Private
  • Views: 48
  • Last Modified:

vba loop through choosing columns again until YES on msg box

The code below works great, however, if the user does not confirm data (maybe has entered wrong column) rather than looping back through, it continues with code.
If the response if NO to this part, loop back through column selection.

    intReply = MsgBox("Use these columns?" & vbCr & vbCr & strMsg, vbYesNo, "Column selection confirmation")
    If intReply = vbNo Then
        MsgBox "Please try again"


Sub HEADERS_MIN_PACKAGE()
Data.Activate

    Dim rng As Range
    Dim rngCols(0 To 8) As Range
    Dim vColPrompt As Variant
    Dim lngCol As Long
    Dim strMsg As String
    Dim intReply As VbMsgBoxResult

    'delete pivot sheet if it exists
      On Error Resume Next
      Application.DisplayAlerts = False

Worksheets(“Report”).Delete

      On Error GoTo 0
      Application.DisplayAlerts = True
    '
    
    
    vColPrompt = Array("Rated Weight", "Date Shipped", "Street Address", "Zone", "Origin Zip", "Recipient Zip", "City", "State", "Ship Type")
    '1. rated weight 2. zone 3. date delivered.
    On Error Resume Next
    For lngCol = 0 To 8
        Set rngCols(lngCol) = Application.InputBox("Please click on a cell in the " & vColPrompt(lngCol) & " column", , , , , , , 8)
    Next
    On Error GoTo 0
    For lngCol = 0 To 8
        If rngCols(lngCol) Is Nothing Then
            MsgBox "Nothing selected for the " & vColPrompt(lngCol) & " column" & vbCr & "Please try again"
            Exit Sub
        Else
            strMsg = strMsg & vColPrompt(lngCol) & " column: " & rngCols(lngCol).Column & " (" & rngCols(lngCol).EntireColumn.Cells(1, 1).Value & ")" & vbCr
        End If
    Next
    intReply = MsgBox("Use these columns?" & vbCr & vbCr & strMsg, vbYesNo, "Column selection confirmation")
    If intReply = vbNo Then
        MsgBox "Please try again"
        Exit Sub
    End If

Open in new window

0
Euro5
Asked:
Euro5
  • 15
  • 13
1 Solution
 
Martin LissOlder than dirtCommented:
Change lines 37 to 41 to

Do Until intReply = vbYes
intReply = MsgBox("Use these columns?" & vbCr & vbCr & strMsg, vbYesNo, "Column selection confirmation")
    If intReply = vbNo Then
        MsgBox "Please try again"
        Exit Sub
    End If
Loop

Open in new window

0
 
Euro5Author Commented:
When I choose NO button, It does give me the Try Again box, but then continues on to a Run-time Error'13' type mismatch because the data never made it to the new sheet.
I am using the code below - did I edit incorrectly?

Sub HEADERS_MIN_PACKAGE()

    Dim rng As Range
    Dim rngCols(0 To 8) As Range
    Dim vColPrompt As Variant
    Dim lngCol As Long
    Dim strMsg As String
    Dim intReply As VbMsgBoxResult


Data.Activate
    '
    
    
    vColPrompt = Array("Rated Weight", "Date Delivered", "Street Address", "Zone", "Origin Zip", "Recipient Zip", "City", "State", "Pay Type")
    '1. rated weight 2. zone 3. date delivered.
    On Error Resume Next
    For lngCol = 0 To 8
        Set rngCols(lngCol) = Application.InputBox("Please click on a cell in the " & vColPrompt(lngCol) & " column", , , , , , , 8)
    Next
    On Error GoTo 0
    For lngCol = 0 To 8
        If rngCols(lngCol) Is Nothing Then
            MsgBox "Nothing selected for the " & vColPrompt(lngCol) & " column" & vbCr & "Please try again"
            Exit Sub
        Else
            strMsg = strMsg & vColPrompt(lngCol) & " column: " & rngCols(lngCol).Column & " (" & rngCols(lngCol).EntireColumn.Cells(1, 1).Value & ")" & vbCr
        End If
    Next
Do Until intReply = vbYes
intReply = MsgBox("Use these columns?" & vbCr & vbCr & strMsg, vbYesNo, "Column selection confirmation")
    If intReply = vbNo Then
        MsgBox "Please try again"
        Exit Sub
    End If
Loop
    'Debug.Print strMsg
    'rename selected columns
    For lngCol = 0 To 8
        rngCols(lngCol).EntireColumn.Cells(1, 1).Value = vColPrompt(lngCol)
    Next
   
    'create criteria range
    Set rng = Sheets("Data").Range("a1").End(xlToRight).Offset(0, 2)
    rng.Value = vColPrompt(0)
    rng.Offset(1, 0).Formula = "="">=""&" & "Details!A3"
    rng.Offset(1, 0).Calculate
    
    Sheets("Data").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Data").Range(rng, rng.Offset(1)), CopyToRange:=Range("Filtered_Data!A1"), Unique:=False
    
    Sheets("Data").Range(rng, rng.Offset(1)).Value = vbNullString
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Remove line 34 (the Exit Sub).
0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

 
Euro5Author Commented:
Now it just bounces me back and forth between the Confirm? msg box and the Try Again! msg box. :)

Sub HEADERS_MIN_PACKAGE()

    Dim rng As Range
    Dim rngCols(0 To 8) As Range
    Dim vColPrompt As Variant
    Dim lngCol As Long
    Dim strMsg As String
    Dim intReply As VbMsgBoxResult


Data.Activate
    '
    
    
    vColPrompt = Array("Rated Weight", "Date Delivered", "Street Address", "Zone", "Origin Zip", "Recipient Zip", "City", "State", "Pay Type")
    '1. rated weight 2. zone 3. date delivered.
    On Error Resume Next
    For lngCol = 0 To 8
        Set rngCols(lngCol) = Application.InputBox("Please click on a cell in the " & vColPrompt(lngCol) & " column", , , , , , , 8)
    Next
    On Error GoTo 0
    For lngCol = 0 To 8
        If rngCols(lngCol) Is Nothing Then
            MsgBox "Nothing selected for the " & vColPrompt(lngCol) & " column" & vbCr & "Please try again"
            Exit Sub
        Else
            strMsg = strMsg & vColPrompt(lngCol) & " column: " & rngCols(lngCol).Column & " (" & rngCols(lngCol).EntireColumn.Cells(1, 1).Value & ")" & vbCr
        End If
    Next
Do Until intReply = vbYes
intReply = MsgBox("Use these columns?" & vbCr & vbCr & strMsg, vbYesNo, "Column selection confirmation")
    If intReply = vbNo Then
        MsgBox "Please try again"

    End If
Loop
    'Debug.Print strMsg
    'rename selected columns
    For lngCol = 0 To 8
        rngCols(lngCol).EntireColumn.Cells(1, 1).Value = vColPrompt(lngCol)
    Next
   
    'create criteria range
    Set rng = Sheets("Data").Range("a1").End(xlToRight).Offset(0, 2)
    rng.Value = vColPrompt(0)
    rng.Offset(1, 0).Formula = "="">=""&" & "Details!A3"
    rng.Offset(1, 0).Calculate
    
    Sheets("Data").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Data").Range(rng, rng.Offset(1)), CopyToRange:=Range("Filtered_Data!A1"), Unique:=False
    
    Sheets("Data").Range(rng, rng.Offset(1)).Value = vbNullString
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Can you supply me with a sample workbook?
0
 
Euro5Author Commented:
0
 
Martin LissOlder than dirtCommented:
Without referring to your actual code, please describe the purpose of the HEADERS_MIN_PACKAGE sub.
0
 
Euro5Author Commented:
It asks the user which column is this data located in? and then names the header. (so that they are always the same later in the code).
Then it chooses the rows where the rated weight is >= the cell reference Details!A3.

Does that help?
0
 
Martin LissOlder than dirtCommented:
I'm asking about the process because think I can improve the process from a users point of view. One more question. You  ask them to name (rename?) the header so that "they are always the same later in the code". Always the same as what, and why would they be different?
0
 
Euro5Author Commented:
Sorry that wasn't very helpful.
The user pastes in shipping data. It will have a variety of rows/columns/header names.
Taking just the "Rated Weight", their data may have header of "Total Weight" or "R_Weight".
I want to rename it, so that later on in the code, the pivot table can identify the "Rated Weight" column.

In the review screen, if they realize that they have chosen the wrong column, I want them to be able to run through choices again, rather than running through entire process with wrong data.
Does that help?
0
 
Martin LissOlder than dirtCommented:
Yes it does.

Rather than prompting them 9 times to select a cell in a column, would a form that has a line for each column which contains the Data column name, a checkbox to indicate that the column is to be selected, and a textbox for the input of the new name (which would only be enabled if the checkbox was checked), be acceptable?
0
 
Euro5Author Commented:
That format sounds fine - the only problem is, we don't want them to input a new column name.
I need to avoid the possibility that the columns would have varied names.
The purpose of this code is to ensure that there is a "Rated Weight", "Zone", "Origin Zip", etc. column.
They just have to tell us WHICH column that data is in.
0
 
Martin LissOlder than dirtCommented:
Try this "proof of concept" workbook. In it I've slightly changed the name of two of the columns in the Data tab. For now after you've selected the "real" name for those two columns the userform closes without anything else happening.
Q-28671328.xlsm
0
 
Euro5Author Commented:
Martin, This looks really good - I love the form. However, I don't know how many columns the user would have - would you list all of them on the left side? It seems like that list could get very long...and not all would have a matching name.
Can you reverse? Have the known column headers identifiers on the left ("Rated Weight", "Zone", etc.) and the list of their column headers in the drop downs?  Just an idea, because like I say, the column list could get very long....
0
 
Martin LissOlder than dirtCommented:
Yes I can do that. Be back later.
0
 
Martin LissOlder than dirtCommented:
Try this version.
Q-28671328a.xlsm
0
 
Martin LissOlder than dirtCommented:
Here's the Q-2867132a (now Q-2867132b) workbook updated with what I think is complete code.
Q-28671328b.xlsm
0
 
Euro5Author Commented:
I LOVE it - if we can show their headers in the drop down! Awesome!!
0
 
Martin LissOlder than dirtCommented:
if we can show their headers in the drop down
It does show the column headers in the comboboxes so I don't know what you mean.
0
 
Euro5Author Commented:
Sorry, I just meant that it is good that the drop down boxes show the users column headers.
0
 
Martin LissOlder than dirtCommented:
OK then before you close this question let me know if there are any problems or if you have any questions about the code.
0
 
Euro5Author Commented:
Running well, but
1. Can you allow the user to scroll back and forth the sheet?
2. Can you rename the UserForm to "Choose columns"?

Is this too picky?
0
 
Martin LissOlder than dirtCommented:
1. Can you allow the user to scroll back and forth the sheet?
Sorry but I don't know what you means.
2. Can you rename the UserForm to "Choose columns"?
In Excel, Press Alt+F11 to open Visual Basic Editor (VBE)

In the menu bar select View|Properties Window

In the "Project" pane under "Forms" double-click frmData

In the "Properties" pane change "Caption" to whatever you want
0
 
Euro5Author Commented:
When the view form is shown, the data is frozen.
While viewing the user form, I would like the user to be able to scroll back and forth on the data tab.
This is so they can see the data in the column if it is outside the view area.

If this is too hard, never mind.
0
 
Martin LissOlder than dirtCommented:
Currently there's a line of code that says frmData.Show. As you might guess, that shows the form, but by default you can't leave the form and go to the sheet and the code below it doesn't get executed until the form is closed. There is an option however which is  frmData.Show vbModeless which allows you to leave the form and go to the sheet but it also allows the following code to be executed immediately, which will cause an error since the comboboxes haven't yet been filled.

Give me a while to do some stuff to allow you to leave the form and to add some validation code so that the user can Quit the column naming process if he wants to without a report being generated.

I may not finish this today because I've got to go out soon but I will get back to you.
0
 
Euro5Author Commented:
No worries, you have worked very hard on this and certainly deserve all the points!
I will try to use the info you have provided to edit anything, but will close with what you have provided so far.
THANK YOU!!
0
 
Euro5Author Commented:
Excellent thank you so much!
0
 
Martin LissOlder than dirtCommented:
The changes were easier than I thought and I've attached a new workbook. Most of the code that used to be in your HEADERS_MIN_PACKAGE macro is now in the userform (which I named "Choose columns".

In any case you're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015
Q-28671328c.xlsm
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 15
  • 13
Tackle projects and never again get stuck behind a technical roadblock.
Join Now