Add an 'ask' function to VBA

[BrutalDawg]

I have a macro that loops through sheet2 column A and if found on sheet1 column A copies to next row on sheet3. The code works well, but I am coming across new sheets, where the code will need to search sheet1 in different columns, ie g,c,h etc. I can just edit the code each time but others are unable to understand. Is there a way when the you run the macro, a dialog box can pop up asking which row to search and automatically change the code? Below is the macro im currently using.

Option ExplicitSub Find_Sort_EDI()
Dim srchLen, myString, nxtRw As Integer
Dim firstAddress As String
Dim c As Range
'Clear Sheet 3 and Copt Column Headings from Sheet 1
 Sheets(3).Cells.ClearContents
 Sheets(1).Rows(1).Copy Destination:=Sheets(3).Rows(1)
'Determine length of Search Criteria Column from Sheet2
   srchLen = Sheets (2).Range("A" & Rows.Count).EndxlUp).Row
'Loop through list in Sheet2, Column A. As each value is
'found in Sheet1, Column A, copy it to the next row in Sheet3
  With Sheets(1).Columns(A")
    For myString = 2 To srchLen
      Set c = .Find(Sheets(2).Range("A" & myString), lookat=xlWhole)
       If Not c Is Nothing Then
        firstAdress = c.Address
         Do
          nxtRw = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
          c.EntireRow.Copy Destination :=Sheets(3).Range("A' & nxtRw)
          Set c = .FindNext(c)
        Loop While Not C Is Nothing And c.Address <> firstAddress
       End If
    Next
  End With
End Sub

 

[Scott T]

I think what you want is a InputBox
https://msdn.microsoft.com/en-us/library/office/ff839468.aspx

 

[L. Howard]

Try this, with a modified column checking code snippet by Jonmo1, which asks for a column letter along with some error checking.
There were typos in your code, so the code here may not be exactly as you posted or perhaps will need some adjustments to work for you.

Note the red font line With Sheets(1).Columns(MyCol) in the macro, this is where the column of choice is given to the code to work on.

You would delete the msgbox code as noted in the macro, its for info only.

Howard

Option Explicit

Sub Find_Sort_EDI()
Dim srchLen, myString, nxtRw As Integer
Dim firstAddress As String
Dim c As Range
Dim lookat&
Dim MyTestRange As Range, MyCol As String
Dim myCheck

MyCol = Application.InputBox("Enter column Letter", , , , , , , 2)

On Error Resume Next

Set MyTestRange = Range(MyCol & 1)

If Not MyTestRange Is Nothing Then
    'MsgBox "valid column entry = " & MyCol
    
  Else
  
    myCheck = MsgBox("INvalid column entry, Re-Enter a Column?", vbYesNo)
    
    If myCheck = vbNo Then
        'MsgBox "Not continue code "
        Exit Sub
    Else
       ' MsgBox "Yes continue code "
        Find_Sort_EDI
    End If
    
End If


''''/ delete this for your regular use \''''
ActiveSheet.Columns(MyCol).Select
MsgBox "Your code starts here." & vbCr & _
       "Column " & """" & MyCol & """" & " has been" & vbCr & _
       "selected as a demo only."
'/////////////////////////////////////////'


'Clear Sheet 3 and Copt Column Headings from Sheet 1
 Sheets(3).Cells.ClearContents
 Sheets(1).Rows(1).Copy Destination:=Sheets(3).Rows(1)
'Determine length of Search Criteria Column from Sheet2
srchLen = Sheets(2).Range("A" & Rows.Count).EndxlUp.Row
'Loop through list in Sheet2, Column A. As each value is
'found in Sheet1, Column A, copy it to the next row in Sheet3
[COLOR=#FF0000]
  With Sheets(1).Columns(MyCol)   ' <<< the column entered in InputBox is used here
[/COLOR]
    For myString = 2 To srchLen

      Set c = .Find(Sheets(2).Range("A" & myString), lookat = xlWhole)

       If Not c Is Nothing Then
        firstAddress = c.Address

         Do

          nxtRw = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
          c.EntireRow.Copy Destination:=Sheets(3).Range("A" & nxtRw)

          Set c = .FindNext(c)

        Loop While Not c Is Nothing And c.Address <> firstAddress

       End If

    Next

  End With

End Sub

 

[BrutalDawg]

Howard,

When I was trying you example, it appears to only pull the header and not of the content below. I tried with several examples, that is should have copied to sheet3. It does not appear to be running after pulling the headers. I have tried with some 3000+ rows and system does not show it is searching correctly. (macro is finished in < 1s.)

Am i doing something wrong, or are we missing something? Appears only the copy headers is working no matter what I try in examples, or actual trial.

thanks for the help

 

[L. Howard]

I did not test the code, was only supplying the input box to provide a column Letter to the variable MyCol. You said your code worked well, so delete my slightly modified code and replace with yours using the MyCol from the inputbox where you thing it should be.

I assumed MyCol would be used in the red font line for the column of interest on sheet 1.

If your code won't play nice with the inputbox MyCol, then perhaps you can provide a link to a sample like workbook along with what you want to happen and where. (No attachments here).

It seems you want to 'Pick' the column on sheet 1 to be a search column (hence the inputbox) and use column A on sheet2 for the search values and when that search value is found in the column of interest on sheet 1, the copy that entire row to sheet 3 to the next open row in column A.

And the headers from sheet1 are copied to sheet 3 each time the code is run.

Howard