Link to home
Start Free TrialLog in
Avatar of Euro5
Euro5Flag for United States of America

asked on

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

Avatar of Martin Liss
Martin Liss
Flag of United States of America image

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

Avatar of Euro5

ASKER

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

Remove line 34 (the Exit Sub).
Avatar of Euro5

ASKER

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

Can you supply me with a sample workbook?
Without referring to your actual code, please describe the purpose of the HEADERS_MIN_PACKAGE sub.
Avatar of Euro5

ASKER

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?
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?
Avatar of Euro5

ASKER

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?
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?
Avatar of Euro5

ASKER

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.
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
Avatar of Euro5

ASKER

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....
Yes I can do that. Be back later.
Try this version.
Q-28671328a.xlsm
ASKER CERTIFIED SOLUTION
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Euro5

ASKER

I LOVE it - if we can show their headers in the drop down! Awesome!!
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.
Avatar of Euro5

ASKER

Sorry, I just meant that it is good that the drop down boxes show the users column headers.
OK then before you close this question let me know if there are any problems or if you have any questions about the code.
Avatar of Euro5

ASKER

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?
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
Avatar of Euro5

ASKER

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.
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.
Avatar of Euro5

ASKER

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!!
Avatar of Euro5

ASKER

Excellent thank you so much!
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