Variable column in code

Hi all and thanks in advance for your help
My question is. Is there a way i can change this code so that the column it is searching i.e. "A" can be variable because i want to take this column from a textbox in a form? :think:
Im having a mind blank

[vba]
Option Explicit

Public Sub ProcessData()
Const TEST_COLUMN As String = "A"
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim this As Worksheet
Dim sh As Worksheet

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Set this = ActiveSheet
With this

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To LastRow

Set sh = Nothing
On Error Resume Next
Set sh = Worksheets(.Cells(i, "A").Value)
On Error Goto 0
If sh Is Nothing Then

Worksheets.Add after:=Worksheets(Worksheets.Count)
Set sh = ActiveSheet
sh.Name = .Cells(i, "A").Value
.Rows(1).Copy sh.Range("A1")
End If

NextRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
.Rows(i).Copy sh.Cells(NextRow, "A")
Next i

End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub [/vba]
Cheers

[VBA]

Option Explicit

Public Sub ProcessData()
Dim IB as string
IB=Inputbox("Enter Column Letter To Use", "Code Column Adjustment")
Const TEST_COLUMN As String = IB
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim this As Worksheet
Dim sh As Worksheet

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Set this = ActiveSheet
With this

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To LastRow

Set sh = Nothing
On Error Resume Next
Set sh = Worksheets(.Cells(i, "A").Value)
On Error Goto 0
If sh Is Nothing Then

Worksheets.Add after:=Worksheets(Worksheets.Count)
Set sh = ActiveSheet
sh.Name = .Cells(i, "A").Value
.Rows(1).Copy sh.Range("A1")
End If

NextRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
.Rows(i).Copy sh.Cells(NextRow, "A")
Next i

End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

[/VBA]when you run this code now a box will pop up asking you fro which column!

A trimmed down version because it's a quiet day.

Be wary about turning you calculations off. If you code bombs out, there is nothing to reset it to automatic, which can cause problems if you don't notice.

[VBA]
Public Sub ProcessData()
Dim IB As String
Dim i As Long
Dim ws As Worksheet
Dim rng As Range
IB = InputBox("Enter Column Letter To Use", "Code Column Adjustment")
Set rng = ActiveSheet.Range(Cells(1, IB), Cells(1, IB).End(xlDown))
For i = 2 To rng.Cells.Count
On Error Resume Next

Set ws = Sheets(CStr(rng(i)))
If ws Is Nothing Then
Set ws = Worksheets.Add(after:=Worksheets(Sheets.Count))
With ws
.Name = rng(i)
rng(1).EntireRow.Copy .Range("A1")
rng(i).EntireRow.Copy .Range("A2")
End With
End If
Set ws = Nothing
Next
End Sub

[/VBA]

Quote:

---

Originally Posted by mdmackillop

Be wary about turning you calculations off. If you code bombs out, there is nothing to reset it to automatic, which can cause problems if you don't notice.

---

Malcolm, the only code I have in personal is to set calculations to on when any workbook is opened and it is for the very reason you cite.

Quote:

---

Originally Posted by mdmackillop

A trimmed down version because it's a quiet day.

Be wary about turning you calculations off. If you code bombs out, there is nothing to reset it to automatic, which can cause problems if you don't notice.

[vba]
Public Sub ProcessData()
Dim IB As String
Dim i As Long
Dim ws As Worksheet
Dim rng As Range
IB = InputBox("Enter Column Letter To Use", "Code Column Adjustment")
Set rng = ActiveSheet.Range(Cells(1, IB), Cells(1, IB).End(xlDown))
For i = 2 To rng.Cells.Count
On Error Resume Next

Set ws = Sheets(CStr(rng(i)))
If ws Is Nothing Then
Set ws = Worksheets.Add(after:=Worksheets(Sheets.Count))
With ws
.Name = rng(i)
rng(1).EntireRow.Copy .Range("A1")
rng(i).EntireRow.Copy .Range("A2")
End With
End If
Set ws = Nothing
Next
End Sub

[/vba]

---

Thanks for this it works well but is there a way to get it to copy all instances in the search column to the new sheet instead of just 1?

Thanks again

I want to put all new instances from a search column into a new sheet named after the instance.

Can you explain or post a book showing what you mean. There is nothing to do that in your original code.

This should clear things up

Please help:banghead:

[VBA]Public Sub ProcessData2()
Dim IB As String
Dim i As Long
Dim ws As Worksheet
Dim rng As Range
IB = InputBox("Enter Column Letter To Use", "Code Column Adjustment")
Application.ScreenUpdating = False
Set rng = ActiveSheet.Range(Cells(1, IB), Cells(1, IB).End(xlDown))
For i = 2 To rng.Cells.Count
On Error Resume Next
Set ws = Sheets(CStr(rng(i)))
If ws Is Nothing Then
Set ws = Worksheets.Add(after:=Worksheets(Sheets.Count))
With ws
.Name = rng(i)
rng.AutoFilter 1, rng(i)
rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy .Range("A1")
End With
End If
Set ws = Nothing
Next
rng.AutoFilter
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub[/VBA]

Many thanks, worked perfectly:rotlaugh: