PDA

View Full Version : Variable column in code



georgiboy
04-06-2008, 08:41 AM
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


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
Cheers

Simon Lloyd
04-06-2008, 08:48 AM
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
when you run this code now a box will pop up asking you fro which column!

mdmackillop
04-06-2008, 10:09 AM
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.


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

lucas
04-06-2008, 10:18 AM
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.

georgiboy
04-06-2008, 10:50 AM
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.


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



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

georgiboy
04-06-2008, 11:38 AM
I want to put all new instances from a search column into a new sheet named after the instance.

mdmackillop
04-06-2008, 12:28 PM
Can you explain or post a book showing what you mean. There is nothing to do that in your original code.

georgiboy
04-07-2008, 02:56 AM
This should clear things up

georgiboy
04-07-2008, 10:34 AM
Please help:banghead:

mdmackillop
04-07-2008, 10:58 AM
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

georgiboy
04-07-2008, 01:36 PM
Many thanks, worked perfectly:rotlaugh: