Insert inputboxes making code more interactive - vba

Question

I am currently working on the following code which is searching through all tabs in an excel workbook, selects all currencies greater a certain threshold in a defined column "J" and if criteria is met the line containing the currency that is greater threshold is pasted in a new created tab called "summary".
Now my question is:
1. Is there any chance to make this code more interactive? What I would like to do, is to add an inputbox in which the user is typing his threshold (in my example 1000000) and this threshold is used for looping through all tabs.
2. It would be great to get an input box like "select column containing currency", as column "J" won't be set all time, it could also be another column ("I", "M" etc) however this will be the same for all sheets then.
3. Any chance to select certain sheets within workbook (STRG + "sheetx" "sheety" etc....) which are then pasted into my loop and all others are neglected?
Any help, especially for my issues within question 1 and 2 is appreciated. Question 3 would only be a "nice-to-have" thing
Option Explicit
Sub Test()
Dim WS As Worksheet
Set WS = Sheets.Add
WS.Name = "Summary"
Dim i As Long, j As Long, lastRow As Long
Dim sh As Worksheet
With Sheets("Summary")
.Cells.Clear
End With
j = 2
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> "Summary" Then
lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
For i = 4 To lastRow
If sh.Range("J" & i) > 1000000 Or sh.Range("J" & i) < -1000000 Then
sh.Range("a" & i & ":n" & i).Copy Destination:=Worksheets("Summary").Range("A" & j)
Sheets("Summary").Range("N" & j) = sh.Name
j = j + 1
End If
Next i
End If
Next sh
Sheets("Summary").Columns("A:N").AutoFit
End Sub

Answer 1

You may want to try this
Option Explicit
Sub Test()
Dim WS As Worksheet
Dim i As Long, j As Long, lastRow As Long
Dim sh As Worksheet
Dim sheetsList As Variant
Dim threshold As Long
Set WS = GetSheet("Summary", True)
sheetsList = Array("STRG","sheetx","sheety") '<--| fill this array with the sheets names to be looped through
threshold = Application.InputBox("Input threshold", Type:=1)
j = 2
For Each sh In ActiveWorkbook.Sheets(sheetsList)
lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
For i = 4 To lastRow
If sh.Range("J" & i) > threshold Or sh.Range("J" & i) < -threshold Then
sh.Range("a" & i & ":n" & i).Copy Destination:=WS.Range("A" & j)
WS.Range("N" & j) = sh.Name
j = j + 1
End If
Next i
Next sh
WS.Columns("A:N").AutoFit
End Sub
Function GetSheet(shtName As String, Optional clearIt As Boolean = False) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(shtName)
If GetSheet Is Nothing Then
Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.count))
GetSheet.Name = shtName
End If
If clearIt Then GetSheet.UsedRange.Clear
End Function

Answer 2

You can set a UserForm as input into the program - something like what follows. You only need to run the 'CreateUserForm' sub once to get the UserForm1 event handlers set up in your spreadsheet. Once that's done you can run the 'Test' to see the UserForm1 itself. You can edit the event handlers to check the user input or reject it if need be. Also once the UserForm1 is set up you can move the various labels and listboxes around and, of course, create new ones. It should look like this:
You can select as many sheets as required from the last listbox and the selections will be added to a vba Collection. See the MsgBox at the beginning of your code and play with entering values/selections into the user box to see what it does.
The UserForm handler that's called when you press the okay button will save the selections to global variables so that they can be picked up in the code.
Option Explicit
' Global Variables used by UserForm1
Public lst1BoxData As Variant
Public threshold As Integer
Public currencyCol As String
Public selectedSheets As Collection
' Only need to run this once. It will create UserForm1.
' If run again it will needlessly create another user form that you don't need.
' Once it's run you can modify the event handlers by selecting the UserForm1
' object in the VBAProject Menu by right clicking on it and selecting 'View Code'
' Note that you can select multiple Sheets on the last listbox of the UserForm
' simply by holding down the shift key.
Sub CreateUserForm()
Dim myForm As Object
Dim X As Integer
Dim Line As Integer
'This is to stop screen flashing while creating form
Application.VBE.MainWindow.Visible = False
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3)
'Create the User Form
With myForm
.Properties("Caption") = "Currency Settings"
.Properties("Width") = 322
.Properties("Height") = 110
End With
' Create Label for threshold text box
Dim thresholdLabel As Object
Set thresholdLabel = myForm.Designer.Controls.Add("Forms.Label.1")
With thresholdLabel
.Name = "lbl1"
.Caption = "Input Threshold:"
.Top = 6
.Left = 6
.Width = 72
End With
'Create TextBox for the threshold value
Dim thresholdTextBox As Object
Set thresholdTextBox = myForm.Designer.Controls.Add("Forms.textbox.1")
With thresholdTextBox
.Name = "txt1"
.Top = 18
.Left = 6
.Width = 75
.Height = 16
.Font.Size = 8
.Font.Name = "Tahoma"
.borderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectSunken
End With
' Create Label for threshold text box
Dim currencyLabel As Object
Set currencyLabel = myForm.Designer.Controls.Add("Forms.Label.1")
With currencyLabel
.Name = "lbl2"
.Caption = "Currency Column:"
.Top = 6
.Left = 100
.Width = 72
End With
'Create currency column ListBox
Dim currencyListBox As Object
Set currencyListBox = myForm.Designer.Controls.Add("Forms.listbox.1")
With currencyListBox
.Name = "lst1"
.Top = 18
.Left = 102
.Width = 52
.Height = 55
.Font.Size = 8
.Font.Name = "Tahoma"
.borderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectSunken
End With
' Create Label for sheet text box
Dim sheetLabel As Object
Set sheetLabel = myForm.Designer.Controls.Add("Forms.Label.1")
With sheetLabel
.Name = "lbl3"
.Caption = "Select Sheets:"
.Top = 6
.Left = 175
.Width = 72
End With
'Create currency column ListBox
Dim sheetListBox As Object
Set sheetListBox = myForm.Designer.Controls.Add("Forms.listbox.1")
With sheetListBox
.Name = "lst3"
.Top = 18
.Left = 175
.Width = 52
.Height = 55
.Font.Size = 8
.MultiSelect = 1
.Font.Name = "Tahoma"
.borderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectSunken
End With
'Create Select Button
Dim selectButton As Object
Set selectButton = myForm.Designer.Controls.Add("Forms.commandbutton.1")
With selectButton
.Name = "cmd1"
.Caption = "Okay"
.Accelerator = "M"
.Top = 30
.Left = 252
.Width = 53
.Height = 20
.Font.Size = 8
.Font.Name = "Tahoma"
.BackStyle = fmBackStyleOpaque
End With
' This will create the initialization sub and the click event
' handler to write the UserForm selections into the global
' variables so they can be used by the code.
myForm.CodeModule.InsertLines 1, "Private Sub UserForm_Initialize()"
myForm.CodeModule.InsertLines 2, " me.lst1.addItem ""Column I"" "
myForm.CodeModule.InsertLines 3, " me.lst1.addItem ""Column J"" "
myForm.CodeModule.InsertLines 4, " me.lst1.addItem ""Column M"" "
myForm.CodeModule.InsertLines 5, " me.lst3.addItem ""Sheet X"" "
myForm.CodeModule.InsertLines 6, " me.lst3.addItem ""Sheet Y"" "
myForm.CodeModule.InsertLines 7, " lst1BoxData = Array(""I"", ""J"", ""M"")"
myForm.CodeModule.InsertLines 8, "End Sub"
'add code for Command Button
myForm.CodeModule.InsertLines 9, "Private Sub cmd1_Click()"
myForm.CodeModule.InsertLines 10, " threshold = CInt(Me.txt1.Value)"
myForm.CodeModule.InsertLines 11, " currencyCol = lst1BoxData(Me.lst1.ListIndex)"
myForm.CodeModule.InsertLines 12, " Set selectedSheets = New Collection"
myForm.CodeModule.InsertLines 13, " For i = 0 To Me.lst3.ListCount - 1"
myForm.CodeModule.InsertLines 14, " If Me.lst3.Selected(i) = True Then"
myForm.CodeModule.InsertLines 15, " selectedSheets.Add Me.lst3.List(i)"
myForm.CodeModule.InsertLines 16, " End If"
myForm.CodeModule.InsertLines 17, " Next"
myForm.CodeModule.InsertLines 18, " Unload Me"
myForm.CodeModule.InsertLines 19, "End Sub"
'Add form to make it available
VBA.UserForms.Add (myForm.Name)
End Sub
' This is your code verbatim except for now
' the UserForm is shown for selecting the
' 1) currency threshold, 2) the column letter
' and 3) the sheets you want to process.
' The MsgBox just shows you what you've
' selected just to demonstrate that it works.
Sub Test()
Dim WS As Worksheet
Set WS = Sheets.Add
WS.Name = "Summary"
Dim i As Long, j As Long, lastRow As Long
Dim sh As Worksheet
With Sheets("Summary")
.Cells.Clear
End With
'**** Start: Running & Checking UserForm Output ****
UserForm1.Show
Dim colItem As Variant
Dim colItems As String
For Each colItem In selectedSheets:
colItems = colItems & " " & colItem
Next
MsgBox ("threshold=" & threshold & vbCrLf & _
"currencyCol=" & currencyCol & vbCrLf & _
"selectedSheets=" & colItems)
'**** End: Running & Checking UserForm Output ****
j = 2
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> "Summary" Then
lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).row
For i = 4 To lastRow
If sh.Range("J" & i) > 1000000 Or sh.Range("J" & i) < -1000000 Then
sh.Range("a" & i & ":n" & i).Copy Destination:=Worksheets("Summary").Range("A" & j)
Sheets("Summary").Range("N" & j) = sh.Name
j = j + 1
End If
Next i
End If
Next sh
Sheets("Summary").Columns("A:N").AutoFit
End Sub

Answer 3

The following code works for my purposes except the selection of single tabs to loop through:
Option Explicit
Sub Test()
Dim column As String
Dim WS As Worksheet
Dim i As Long, j As Long, lastRow As Long
Dim sh As Worksheet
Dim sheetsList As Variant
Dim threshold As Long
Set WS = GetSheet("Summary", True)
threshold = Application.InputBox("Input threshold", Type:=1)
column = Application.InputBox("Currency Column", Type:=2)
j = 2
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> "Summary" Then
lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
For i = 4 To lastRow
If sh.Range(column & i) > threshold Or sh.Range(column & i) < -threshold Then
sh.Range("a" & i & ":n" & i).Copy Destination:=WS.Range("A" & j)
WS.Range("N" & j) = sh.Name
j = j + 1
End If
Next i
End If
Next sh
WS.Columns("A:N").AutoFit
End Sub
Function GetSheet(shtName As String, Optional clearIt As Boolean = False) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(shtName)
If GetSheet Is Nothing Then
Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
GetSheet.Name = shtName
End If
If clearIt Then GetSheet.UsedRange.Clear
End Function