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

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

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