| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change InputBox Range Selection to Column Letter Selection
Hi,
I'm using the macro below that I found on the net. It works fine, but you'll notice that the InputBox asks the user to select the range (Type: = 8). I'm trying to modify the macro so that it asks the user for the column letter within which the grouping labels exist (rather than range selection), and then incorporate that information into the macro to execute the task. I can create such an InputBox just fine (e.g., column_letter = Application.InputBox("Which column (letter) contains the grouping variable labels?", Type:=2), the problem is that I don't know how to integrate it into the rest of the macro to work. Any advice greatly appreciated. Dim rng_grouping1 As Range rng_regrouping As Long rng_resized As Long output_array2() criteria1 As Long criteria2 As Long myNum As Double number_value2 As Long Sheets("Data").Select Set rng_grouping1 = Application.InputBox _ ("Select the spreadsheet range that contains the unit labels", Type:=8) If rng_grouping1 Is Nothing Then Exit Sub rng_regrouping = rng_grouping1.Value: Set rng_grouping1 = Nothing Set rng_grouping1 = Range("Data!$FF:$FI") If rng_grouping1 Is Nothing Then Exit Sub rng_resized = rng_grouping1.Resize(UBound(rng_regrouping, 1), 4).Value myNum = 0.999999 ReDim output_array2(1 To UBound(rng_regrouping, 1), 1 To 5) With CreateObject("Scripting.Dictionary") .CompareMode = vbTextCompare For criteria1 = 1 To UBound(rng_regrouping, 1) If Not .exists(rng_regrouping(criteria1, 1)) Then number_value2 = number_value2 + 1: output_array2(number_value2, 1) = rng_regrouping(criteria1, 1): .Item(rng_regrouping(criteria1, 1)) = number_value2 End If For criteria2 = 1 To 4 If (rng_resized(criteria1, criteria2) 0) * (rng_resized(criteria1, criteria2) < myNum) Then output_array2(.Item(rng_regrouping(criteria1, 1)), criteria2 + 1) = output_array2(.Item(rng_regrouping(criteria1, 1)), criteria2 + 1) + 1 End If Next Next End With With Sheets("Units_Fit").Cells(1) .Resize(, 5).Value = Array("Unit", "R_AVG", "M_AVG", "T_AVG", "O_AVG") With .Offset(1).Resize(number_value2, 5) .Value = output_array2 On Error Resume Next .SpecialCells(4).Value = 0 End With End With End Sub |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Change InputBox Range Selection to Column Letter Selection
Try
Dim strCol As String strCol = InputBox("Which column (letter) " & _ "contains the grouping variable labels?") Set rng_grouping1 = Range("Data!" & strCol & ":" & strCol) If this post helps click Yes --------------- Jacob Skaria "intoit" wrote: Hi, I'm using the macro below that I found on the net. It works fine, but you'll notice that the InputBox asks the user to select the range (Type: = 8). I'm trying to modify the macro so that it asks the user for the column letter within which the grouping labels exist (rather than range selection), and then incorporate that information into the macro to execute the task. I can create such an InputBox just fine (e.g., column_letter = Application.InputBox("Which column (letter) contains the grouping variable labels?", Type:=2), the problem is that I don't know how to integrate it into the rest of the macro to work. Any advice greatly appreciated. Dim rng_grouping1 As Range rng_regrouping As Long rng_resized As Long output_array2() criteria1 As Long criteria2 As Long myNum As Double number_value2 As Long Sheets("Data").Select Set rng_grouping1 = Application.InputBox _ ("Select the spreadsheet range that contains the unit labels", Type:=8) If rng_grouping1 Is Nothing Then Exit Sub rng_regrouping = rng_grouping1.Value: Set rng_grouping1 = Nothing Set rng_grouping1 = Range("Data!$FF:$FI") If rng_grouping1 Is Nothing Then Exit Sub rng_resized = rng_grouping1.Resize(UBound(rng_regrouping, 1), 4).Value myNum = 0.999999 ReDim output_array2(1 To UBound(rng_regrouping, 1), 1 To 5) With CreateObject("Scripting.Dictionary") .CompareMode = vbTextCompare For criteria1 = 1 To UBound(rng_regrouping, 1) If Not .exists(rng_regrouping(criteria1, 1)) Then number_value2 = number_value2 + 1: output_array2(number_value2, 1) = rng_regrouping(criteria1, 1): .Item(rng_regrouping(criteria1, 1)) = number_value2 End If For criteria2 = 1 To 4 If (rng_resized(criteria1, criteria2) 0) * (rng_resized(criteria1, criteria2) < myNum) Then output_array2(.Item(rng_regrouping(criteria1, 1)), criteria2 + 1) = output_array2(.Item(rng_regrouping(criteria1, 1)), criteria2 + 1) + 1 End If Next Next End With With Sheets("Units_Fit").Cells(1) .Resize(, 5).Value = Array("Unit", "R_AVG", "M_AVG", "T_AVG", "O_AVG") With .Offset(1).Resize(number_value2, 5) .Value = output_array2 On Error Resume Next .SpecialCells(4).Value = 0 End With End With End Sub |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Change InputBox Range Selection to Column Letter Selection
Thanks, Jabob. Greatly appreciated.
"Jacob Skaria" wrote: Try Dim strCol As String strCol = InputBox("Which column (letter) " & _ "contains the grouping variable labels?") Set rng_grouping1 = Range("Data!" & strCol & ":" & strCol) If this post helps click Yes --------------- Jacob Skaria "intoit" wrote: Hi, I'm using the macro below that I found on the net. It works fine, but you'll notice that the InputBox asks the user to select the range (Type: = 8). I'm trying to modify the macro so that it asks the user for the column letter within which the grouping labels exist (rather than range selection), and then incorporate that information into the macro to execute the task. I can create such an InputBox just fine (e.g., column_letter = Application.InputBox("Which column (letter) contains the grouping variable labels?", Type:=2), the problem is that I don't know how to integrate it into the rest of the macro to work. Any advice greatly appreciated. Dim rng_grouping1 As Range rng_regrouping As Long rng_resized As Long output_array2() criteria1 As Long criteria2 As Long myNum As Double number_value2 As Long Sheets("Data").Select Set rng_grouping1 = Application.InputBox _ ("Select the spreadsheet range that contains the unit labels", Type:=8) If rng_grouping1 Is Nothing Then Exit Sub rng_regrouping = rng_grouping1.Value: Set rng_grouping1 = Nothing Set rng_grouping1 = Range("Data!$FF:$FI") If rng_grouping1 Is Nothing Then Exit Sub rng_resized = rng_grouping1.Resize(UBound(rng_regrouping, 1), 4).Value myNum = 0.999999 ReDim output_array2(1 To UBound(rng_regrouping, 1), 1 To 5) With CreateObject("Scripting.Dictionary") .CompareMode = vbTextCompare For criteria1 = 1 To UBound(rng_regrouping, 1) If Not .exists(rng_regrouping(criteria1, 1)) Then number_value2 = number_value2 + 1: output_array2(number_value2, 1) = rng_regrouping(criteria1, 1): .Item(rng_regrouping(criteria1, 1)) = number_value2 End If For criteria2 = 1 To 4 If (rng_resized(criteria1, criteria2) 0) * (rng_resized(criteria1, criteria2) < myNum) Then output_array2(.Item(rng_regrouping(criteria1, 1)), criteria2 + 1) = output_array2(.Item(rng_regrouping(criteria1, 1)), criteria2 + 1) + 1 End If Next Next End With With Sheets("Units_Fit").Cells(1) .Resize(, 5).Value = Array("Unit", "R_AVG", "M_AVG", "T_AVG", "O_AVG") With .Offset(1).Resize(number_value2, 5) .Value = output_array2 On Error Resume Next .SpecialCells(4).Value = 0 End With End With End Sub |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Combo Box selection only shows bound column info after selection made. | Excel Programming | |||
| Range(Selection, Selection.End(xlToRight)).Select | Excel Programming | |||
| Change from Column Selection to Cell Selection | Excel Programming | |||
| Other option of InputBox for range selection | Excel Programming | |||
| Excel VBA - Range(Selection, Selection.End(xlDown)).Name issue. | Excel Programming | |||
Linear Mode
