VBA code to set range

RedOctoberKnight

Board Regular
Joined
Nov 16, 2015
Messages
153
Office Version
  1. 2016
Platform
  1. Windows
Good Afternoon,

I have the following code that I found online (not taking credit for it at all as it's way past my skill level). As most of you can probably tell by reading it, it takes a range of data and sorts it into different sheets by whichever column you choose. The code works great but i'm hoping to eliminate some steps. It required you to select the column headers and then requires you to select all the data in the column from which you want to sort.

My header columns are always going to be A16:N16 and my sorting column will always start at K17. I want to have the sorting column find the last row with data and use it as the range. So basically K17:K??. I basically want to eliminate having to input the sorting parameters myself.

There are a few "notes" that I have tried to use but it doesn't work. Any help would be much appreciated.

VBA Code:
Sub Splitdatabycol()
'by Extendoffice
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
On Error Resume Next
'xTRg = Range("A16:N16")
Set xTRg = Application.InputBox("HIGHLIGHT THE COLUMN HEADERS IN BLUE:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("HIGHLIGHT THE DAYS OF THE WEEK COLUMN IN GREEN:", "Kutools for Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
'Set xVRg = Range("K17").End(xlDown).Row
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
Sheets(myarr(i) & "").Paste Destination:=Sheets(myarr(i) & "").Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
TBH I didn't study all of that code but perhaps replace the input box lines with these?

Set xTRg = Range("A16:N16")
Set xVRg = Range("K17:K" & Rows.count).End(xlUp).Row)

No idea where your code resides so maybe you need a sheet reference there as well.
 
Upvote 0
Thanks for the response Micron but I get a compile error when setting xVRg. Is it missing a "(" somewhere?
 
Upvote 0
Thanks for the response Micron but I get a compile error when setting xVRg. Is it missing a "(" somewhere?
I actually think I figured it out. Thank you for getting me headed in the right direction! Much appreciated!


VBA Code:
Set xVRg = Range("K17:K" & Cells(Rows.Count).End(xlUp).Row)
 
Upvote 0
Glad you figured it out. The snippet I posted worked for me for something else but I don't think it was to set a range object.
 
Upvote 0

Forum statistics

Threads
1,224,832
Messages
6,181,234
Members
453,026
Latest member
cknader

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top