Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > I need to add an Input Box
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9
Default I need to add an Input Box
I need to add an InputBox to the following script to ask me which
column to use to separate the data. Does anyone know how to add the
InputBox.

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long



Set ws1 = Sheets("Sheet1") '<<< Change

'Tip : You can also use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change



With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With



With ws1
rng.Columns(3).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True

'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used
to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you
use the columns)


Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value



For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value

Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,123
Default I need to add an Input Box
Try this

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim num As Long

Set ws1 = Sheets("Sheet1") '<<< Change
'Tip : You can also use a Dynamic range name, http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change

num = Application.InputBox(prompt:="Type a column number", Type:=1)
If num 0 And num < ws1.Range("A1").CurrentRegion.Columns.Count Then

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(num).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change this if needed)
'You see that the last two columns of the worksheet are used to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Next
.Columns("IU:IV").Clear
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End If
End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


wrote in message oups.com...
I need to add an InputBox to the following script to ask me which
column to use to separate the data. Does anyone know how to add the
InputBox.

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long



Set ws1 = Sheets("Sheet1") '<<< Change

'Tip : You can also use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change



With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With



With ws1
rng.Columns(3).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True

'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used
to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you
use the columns)


Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value



For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value

Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,123
Default I need to add an Input Box
< ws1.Range("A1").CurrentRegion.Columns.Count

Must be

<= ws1.Range("A1").CurrentRegion.Columns.Count


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ron de Bruin" wrote in message ...
Try this

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim num As Long

Set ws1 = Sheets("Sheet1") '<<< Change
'Tip : You can also use a Dynamic range name, http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change

num = Application.InputBox(prompt:="Type a column number", Type:=1)
If num 0 And num < ws1.Range("A1").CurrentRegion.Columns.Count Then

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(num).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change this if needed)
'You see that the last two columns of the worksheet are used to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Next
.Columns("IU:IV").Clear
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End If
End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


wrote in message oups.com...
I need to add an InputBox to the following script to ask me which
column to use to separate the data. Does anyone know how to add the
InputBox.

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long



Set ws1 = Sheets("Sheet1") '<<< Change

'Tip : You can also use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change



With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With



With ws1
rng.Columns(3).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True

'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used
to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you
use the columns)


Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value



For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value

Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9
Default I need to add an Input Box
On Mar 9, 6:16 pm, "Ron de Bruin" wrote:
< ws1.Range("A1").CurrentRegion.Columns.Count

Must be

<= ws1.Range("A1").CurrentRegion.Columns.Count

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ron de Bruin" wrote in . ..

Try this

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim num As Long

Set ws1 = Sheets("Sheet1") '<<< Change
'Tip : You can also use a Dynamic range name,http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change

num = Application.InputBox(prompt:="Type a column number", Type:=1)
If num 0 And num < ws1.Range("A1").CurrentRegion.Columns.Count Then

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(num).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change this if needed)
'You see that the last two columns of the worksheet are used to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Next
.Columns("IU:IV").Clear
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End If
End Sub

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

wrote in ooglegroups.com...
I need to add an InputBox to the following script to ask me which
column to use to separate the data. Does anyone know how to add the
InputBox.

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long

Set ws1 = Sheets("Sheet1") '<<< Change

'Tip : You can also use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(3).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True

'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used
to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you
use the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value

Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0

Thank a lot Ron, That is great. What would I need to change if I
wanted to enter Column "C" instead of Column "3"?

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,123
Default I need to add an Input Box
This is possible but you need a lot of error checking
Why not run it for the column where the activecell is ?
Is that a option ?


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


wrote in message ups.com...
On Mar 9, 6:16 pm, "Ron de Bruin" wrote:
< ws1.Range("A1").CurrentRegion.Columns.Count

Must be

<= ws1.Range("A1").CurrentRegion.Columns.Count

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ron de Bruin" wrote in . ..

Try this

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim num As Long

Set ws1 = Sheets("Sheet1") '<<< Change
'Tip : You can also use a Dynamic range name,http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change

num = Application.InputBox(prompt:="Type a column number", Type:=1)
If num 0 And num < ws1.Range("A1").CurrentRegion.Columns.Count Then

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(num).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change this if needed)
'You see that the last two columns of the worksheet are used to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Next
.Columns("IU:IV").Clear
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End If
End Sub

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

wrote in ooglegroups.com...
I need to add an InputBox to the following script to ask me which
column to use to separate the data. Does anyone know how to add the
InputBox.

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long

Set ws1 = Sheets("Sheet1") '<<< Change

'Tip : You can also use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1").CurrentRegion '<<< Change

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(3).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True

'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used
to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you
use the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value

Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0

Thank a lot Ron, That is great. What would I need to change if I
wanted to enter Column "C" instead of Column "3"?

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
input in number form is being multiplied by 1000 when i input. jweinograd Excel Discussion (Misc queries) 4 April 16th 07 11:18 PM
Have user input converted to uppercase in same cell as input? Shannonn New Users to Excel 1 June 20th 06 03:19 AM
How do I add input data in the input ranges in drop down boxes. oil_driller Excel Discussion (Misc queries) 1 November 9th 05 10:31 PM
=SUMIF(Input!H2:H718,AZ19,Input!E2:E685)AND(IF ALex Excel Worksheet Functions 2 March 14th 05 09:19 PM
CODE to select range based on User Input or Value of Input Field Sandi Gauthier Excel Programming 4 December 8th 03 03:22 PM


All times are GMT +1. The time now is 04:01 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement