none
Setting R - iCol variable RRS feed

  • Question

  • I have this code that has been written by someone else and I tweaked to match my needs. It has a step that is unnecessary which asks me to specify which column I want to be "extracted by". I simply want it by Column H, how can I get it to stop asking me and just set to Column H?  See below:

    starting from the middle..

       

    Const NameCol = "A"
    Const HeaderRow = 1
    Const FirstRow = 2
    Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
    Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
    Dim sh As Worksheet, Master As String
    On Error Resume Next
    ActiveSheet.Unprotect ("Your Password")
    Set r = Application.InputBox("Click in the column to extract by", Type:=8)
    On Error GoTo 0
    If r Is Nothing Then Exit Sub
    iCol = r.Column
    t = Now
    Application.ScreenUpdating = False
    With ActiveSheet
        Master = .Name
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
            .Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        iStart = 2
        For i = 2 To LastRow
            If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
                iEnd = i
                Columns.AutoFit
                Columns("A:D").ColumnWidth = 14.14
                Columns("Y").ColumnWidth = 75
                Sheets.Add after:=Sheets(Sheets.Count)
                Set ws = ActiveSheet
                On Error Resume Next
                ws.Name = byStartHole.Cells(, iStart, iCol).Value
                On Error GoTo 0
                .Range(.Cells(1, 1), .Cells(1, LastCol)).Copy ws.Range("A1")
                .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
                iStart = iEnd + 1
                End If
        Next i
    End With

    etc,,,

    Tuesday, June 23, 2015 9:51 PM

All replies

  • Remove (or comment out) the lines

     Set r = Application.InputBox("Click in the column to extract by", Type:=8)

    and

     If r Is Nothing Then Exit Sub

    Change the line

     iCol = r.Column

    to

     iCol = 8

    (column H is the 8th column)


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Tuesday, June 23, 2015 10:06 PM
  • Nevermind, was able to figure it out. I erased R as Range and input box with 
    Set r = Range(Range("h2"), Range("H" & Rows.Count).End(xlUp))
    Tuesday, June 23, 2015 10:13 PM