Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 410
Default Need help simplifying VBA code

I am trying to go through a list after a new name has been added to
the bottom. If it matches any of the other names then it will exit.
If it does nto then it will copy it to D1. I knwo this works, but is
there an easier way to do this? I have several columns I need to
write this for and woudl prefer somethign easier.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Target.Column = 1 Then
Range("A1").Select
Do Until Selection = Target.Row + 1
If Selection.Value = Target.Value Then
Exit Sub
Else
Selection.Offset(1, 0).Select
End If
If Selection.Row = Target.Row Then
Range("A" & Target.Row).Copy Destination:=Range("D1")
Exit Sub
End If
Loop
End If
End Sub

Thanks,
Jay
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 5,939
Default Need help simplifying VBA code

Try using countif...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Column = 1 Then
Application.EnableEvents = False
Set rng = Range(Range("A1"), Target.Offset(-1, 0))
If Application.WorksheetFunction.CountIf(rng, Target.Value) = 0 Then _
Target.Copy Destination:=Range("D1")
Application.EnableEvents = True
End If
End Sub
--
HTH...

Jim Thomlinson


"jlclyde" wrote:

I am trying to go through a list after a new name has been added to
the bottom. If it matches any of the other names then it will exit.
If it does nto then it will copy it to D1. I knwo this works, but is
there an easier way to do this? I have several columns I need to
write this for and woudl prefer somethign easier.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Target.Column = 1 Then
Range("A1").Select
Do Until Selection = Target.Row + 1
If Selection.Value = Target.Value Then
Exit Sub
Else
Selection.Offset(1, 0).Select
End If
If Selection.Row = Target.Row Then
Range("A" & Target.Row).Copy Destination:=Range("D1")
Exit Sub
End If
Loop
End If
End Sub

Thanks,
Jay

  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 1,081
Default Need help simplifying VBA code

VBA code, generally speaking, is far more efficient when you don't SELECT
cells or ranges, especially in a loop.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long
If Target.Column = 1 Then
x = Application.WorksheetFunction.CountIf(Range(Cells( 1, Target.Column),
_Cells(Target.Row - 1, Target.Column)), Target.Value)
If x 1 Then Range("D1") = Target.Value
End If
End Sub


"jlclyde" wrote:

I am trying to go through a list after a new name has been added to
the bottom. If it matches any of the other names then it will exit.
If it does nto then it will copy it to D1. I knwo this works, but is
there an easier way to do this? I have several columns I need to
write this for and woudl prefer somethign easier.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Target.Column = 1 Then
Range("A1").Select
Do Until Selection = Target.Row + 1
If Selection.Value = Target.Value Then
Exit Sub
Else
Selection.Offset(1, 0).Select
End If
If Selection.Row = Target.Row Then
Range("A" & Target.Row).Copy Destination:=Range("D1")
Exit Sub
End If
Loop
End If
End Sub

Thanks,
Jay

  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 410
Default Need help simplifying VBA code

On Sep 4, 10:07*am, Duke Carey
wrote:
VBA code, generally speaking, is far more efficient when you don't SELECT
cells or ranges, especially in a loop.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long
If Target.Column = 1 Then
* * x = Application.WorksheetFunction.CountIf(Range(Cells( 1, Target..Column), *
* * * * *_Cells(Target.Row - 1, Target.Column)), Target.Value)
* * *If x 1 Then Range("D1") = Target.Value
End If
End Sub



"jlclyde" wrote:
I am trying to go through a list after a new name has been added to
the bottom. *If it matches any of the other names then it will exit.
If it does nto then it will copy it to D1. *I knwo this works, but is
there an easier way to do this? *I have several columns I need to
write this for and woudl prefer somethign easier.


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
* * If Target.Column = 1 Then
* * * * Range("A1").Select
* * * * Do Until Selection = Target.Row + 1
* * * * If Selection.Value = Target.Value Then
* * * * * * Exit Sub
* * * * Else
* * * * * * Selection.Offset(1, 0).Select
* * * * End If
* * * * If Selection.Row = Target.Row Then
* * * * * * Range("A" & Target.Row).Copy Destination:=Range("D1")
* * * * * * Exit Sub
* * * * End If
* * * * Loop
* * End If
End Sub


Thanks,
Jay- Hide quoted text -


- Show quoted text -


Duke
Thanks for the code. This is going to work great. I am aware that
code runs faster without using the select, I just could not figure out
away around it without doing the Select.

Thanks Again,
Jay
  #5   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 9,101
Default Need help simplifying VBA code

try this

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
If Target.Column = 1 And Target.Row < 1 Then
Set SearchRange = Range("A1:A" & (Target.Row - 1))
Set c = SearchRange.Find(what:=Target.Value, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
Range("D1").value = Target.Value
End If
End If
End Sub


"jlclyde" wrote:

I am trying to go through a list after a new name has been added to
the bottom. If it matches any of the other names then it will exit.
If it does nto then it will copy it to D1. I knwo this works, but is
there an easier way to do this? I have several columns I need to
write this for and woudl prefer somethign easier.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Target.Column = 1 Then
Range("A1").Select
Do Until Selection = Target.Row + 1
If Selection.Value = Target.Value Then
Exit Sub
Else
Selection.Offset(1, 0).Select
End If
If Selection.Row = Target.Row Then
Range("A" & Target.Row).Copy Destination:=Range("D1")
Exit Sub
End If
Loop
End If
End Sub

Thanks,
Jay

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

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
Code needs simplifying Sandy Excel Worksheet Functions 5 April 26th 07 01:31 PM
Simplifying VBA code Michael M Excel Worksheet Functions 8 January 24th 07 02:17 PM
simplifying routine KneeDown2Up New Users to Excel 5 January 4th 07 05:28 PM
Simplifying a formula MartinW Excel Worksheet Functions 3 June 19th 06 11:50 AM
Simplifying formula m.cain Excel Discussion (Misc queries) 1 March 24th 06 11:35 AM


All times are GMT +1. The time now is 01:31 AM.

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

About Us

"It's about Microsoft Excel"