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
|
Similar Threads
