Move Cell Content Based on an Event.

[dmorri254]

I am trying to create a function that will moved cell content from one sheet to another based on an event.

Example: If D1=Yes, then move the values in A1,B1 and C1 to
sheet2, cells, A1,B1,C1.

I have tried doing an If,then, copy, move etc, with no luck.
I wrote a macro and assigned it to a button but it ignored the if=yes condition.

My goal is to have the user build a contact list based on if he answers yes to a given question. I want this to be the last action he performs after the form is filled out.
My VB skills are very basic so if you respond, please speak soft and slow.

Thanx for the help...

 

[msmith]

dmorri254,

You mentioned basing the desired action on an event. The following code will run whenever a cell is changed:

Private Sub Worksheet_Change(ByVal Target As Range)
  
  If Target.Cells.Count > 1 Or Target.Column <> 4 Then Exit Sub
    
  On Error Resume Next
  If UCase(Target.Value) = &quot;YES&quot; Then
    Application.EnableEvents = False
    With ActiveSheet
      .Range(.Cells(Target.Row, 1), .Cells(Target.Row, 3)).Copy
      Worksheets(&quot;Sheet2&quot;).Cells(1, 1).PasteSpecial Paste:=xlPasteValues
      Application.CutCopyMode = False
      .Range(.Cells(Target.Row, 1), .Cells(Target.Row, 4)).ClearContents
    End With
    Application.EnableEvents = True
  End If
  
End Sub

This event procedure checks to see if the range of changed cells is more than one cell or not in Column D, in which case it exits without taking action. It then inspects the contents of the changed cell (which will be in Col. D) and if equal to YES, carries out a copy/paste/clear contents operation. This effectively moves the contents of A1, B1 and C1 to "Sheet2".

To implement this, open the VBE by selecting Tools/Macro/Visual Basic Editor or pressing Alt+F11. In the VBE, double-click on the icon for the main worksheet in the left-hand pane (Project Explorer). This activates the code module for this worksheet. From the left dropdown in the code editor, which will initially show "General", select "Worksheet". This will cause the Worksheet_SelectionChange event procedure shell to be added. Ignore this and select "Change" from the right dropdown. This will add a blank shell for the Worksheet_Change event procedure. Copy the code above between the Sub declaration and End Sub.

If you want to run this from a button on the worksheet instead of automatically when the user enters YES in Col D then some modification will be necessary. Please post back as to how this works for you or if you need further assistance.

Regards,
Mike

 

[dmorri254]

UREEKA!!....Hey it worked...okay so how do I attach it to a button because I want the user to build this list then I want the to go back and press the button so that it will build a contact list for them....
Also, if I understand correctly, this will check gthe entire range in those columns correct??

Thank you so much for your help

David

 

[IRstuff]

IF you goto to the Customize Menu, by right-clicking the toolbar region, going to the Commands tab, scroll down to Macros, there should be a smiley face custom button and add the button, you can then assign a macro to it.

TTFN
TTFN

 

[dmorri254]

Hmm....Okay I have now run into a challenge with this code.
For all practical uses it does work however, I need for it to fill the list downwards. As it is now, it overwrites each entry. I know for most of you this is basic stuff but I am a novice so please forgive me....how do I modify this code to copy each entry going down columns a,b & c into the next columns on sheet2?
This will build the list.....

If I understand correctly, I would need to modify the Target.row portions of the code...correct??

Thanx again

 

[IRstuff]

Although, if you're copying columns, it might be easier to copy the entire range in one fell swoop. It will run much faster.

You'll probably need to use the macro recorder to see the syntax for selecting and copying entire ranges or columns.

TTFN TTFN

 

[dmorri254]

So are you saying modify the code to look for "yes" in column D in the range of d1:dwhatever.....do the same with the other columns and rows correct??

Thanx

 

[IRstuff]

I think that's pretty much it.

Use the single-step buttons in VBE to see what the macro does at each line. When you're in debug mode, you can also see what the variables' values are.

TTFN TTFN

 

[dmorri254]

Okay,

I got it to work by changing a few things:

If Target.Cells.Count > 1 Or Target.Column <> 4 Then Exit Sub

On Error Resume Next
If UCase(Target.Value) = &quot;YES&quot; Then
Application.EnableEvents = False
With ActiveSheet
.Range(.Cells(Target.Row, 1), .Cells(Target.Row, 3)).Copy
Worksheets(&quot;Sheet2&quot.Cells(Target.Row, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
Application.EnableEvents = True
End If

The problem is it needs to be a bit more intelligent. It needs to be able to find the next row. What it does now is it will leave a blank row if the text in D=No.....how woyld I modify to find the last row used??

 

[IRstuff]

I guess that it depends on you. The assumption, I presume is that you would have either &quot;yes&quot;, &quot;no&quot; or a blank to signify the end of the table.

You would then wrap something like:

While target.value <>&quot;&quot;
<the basic copy routine.>
wend

TTFN

TTFN

 

[dmorri254]

Okay I have one more question maybe two but for sure one.....how do I assign this code to a command button..the above did not help me..what am I doing wrong??

 

[IRstuff]

What part of the procedure is not working?
> Can you get the Customize menu?
> Can you get the macro selection?
> Can you get the custom button for macros?
> Is the macro assignment failing?


TTFN

 

[dmorri254]

The macro assignment is failing....since it is not a macro just code, I dont have a name for it ..it asks to create a macro it only gives the general not the worksheet so where do I put the code to turn it inot a macro??

Thanx

 

[msmith]

David,

I've completely re-written the procedure to accommodate its being called from a commandbutton. It will now loop through all entries in the main list and copy only those where the user has entered &quot;yes&quot; in column D. It creates a new worksheet named &quot;Custom Contact List&quot; each time it is run. It also deletes an existing worksheet of the same name, currently without warning, though this is easy to change. There is a constant &quot;HeaderRowNum&quot; that tells the procedure which row the header line is on. It is currently set to 1, but can be changed if your header row is different. If there is no header row, set it equal to zero. If you have your custom toolbar/button set up, simply assign the name of this procedure to its OnAction property or Macro assignment. Here is the code:

Sub BuildList()
Const HeaderRowNum = 1
Dim OneCell As Range
Dim LastUsedRow As Long
Dim Rng As Range
Dim ListCount As Long
Dim wksContact As Worksheet

  On Error Resume Next
  
  With ActiveSheet
    LastUsedRow = .Cells(65536, 1).End(xlUp).Row
    If LastUsedRow <= HeaderRowNum Then Exit Sub 'Nothing in List
  
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(&quot;Custom Contact List&quot;).Delete
    Application.DisplayAlerts = True
    Set wksContact = ThisWorkbook.Worksheets.Add
    wksContact.Name = &quot;Custom Contact List&quot;
    
    If HeaderRowNum > 0 Then
      .Cells(HeaderRowNum, 1).EntireRow.Copy
      wksContact.Cells(1, 1).PasteSpecial Paste:=xlPasteAll
      Application.CutCopyMode = False
    End If
    
    Set Rng = .Range(.Cells(HeaderRowNum + 1, 4), .Cells(LastUsedRow, 4))
  
    For Each OneCell In Rng
      If UCase(OneCell.Text) = &quot;YES&quot; Then
        ListCount = ListCount + 1
        .Range(.Cells(OneCell.Row, 1), .Cells(OneCell.Row, 3)).Copy
        wksContact.Cells(HeaderRowNum + ListCount, 1).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
'Un-Comment following line if you want to clear main worksheet entries.
'        .Range(.Cells(OneCell.Row, 1), .Cells(OneCell.Row, 4)).ClearContents
      End If
    Next OneCell
  End With
    
End Sub[\code]

Let me know if you need further assistance implementing this or have other questions.

Regards,
Mike

 

[dmorri254]

WOW!! I think we have struck gold!! Thank you so much for the help this is awsome!!!
This does what I want it to do however...it creates a new sheet...I like this but as a point of advise for me...I have a sheet called technical resources that lists who the resources are for a project and it asks weather or not this person will participate in a test. If the answer is yes, then the last thing the user should do is click the button to build the participant list. Okay....now the only problem that I have with this code is that it will create a new sheet but it inserts it at the front...is it possible to say copy these &quot;yes&quot; entries into specifed cells on another sheet that already exists?? For example, I have a space in the overview portion of the document that list the participants lets say a1,b1,c1 etc(name,dept,ext.server)...so I would like the data to go on that sheet in specified cells....
Does this make sense...or should I just have it create a new sheet and keep it separate??

Thanx
David

 

[msmith]

David,

That is no problem. What is the name of the existing worksheet? Will the contact list need to overwrite an existing list on this other worksheet or should it be appended to any existing list? What is the starting row for this list?


Regards,
Mike

 

[dmorri254]

Okay ...there are two workbooks in this one is a plan, the other is a script. The testplan builds the test script.
The name of the sheet on the testplan is called Technical Resources. The contact name, ext, server and yes/no are in col, b,c,d,e,f respectivly with input beginning at row 3 to row 19,

The next section begins on row22...same information type, different resource...the sheet that it builds is in a workbook called &quot;Project Name&quot; test script...and the sheet is called overview.

The participant list starts at row 26 same as above going across....Now as the list grows, yes it will need to be appended. I like this code because I have another function in the application that I can use it in.
(Let me know if this is clear)

One sheet builds an issue log and if I have any post implementation issues, I want it to auto build that sheet as well...I am doing this to automate documentation my group creates on a project by project basis. This is proving to save time as we usually create at least four doucments per project for logging and reporting. I have made them inot one living document that creats all four but have run inot some programming problems...Again I am greatful for the help in this frustrating project of mine...

 

[msmith]

David,

Sorry, but you've lost me. Without seeing your layout, it's a bit difficult to follow. However, I will try to give some general direction on how to modify the BuildList procedure. First, you'll want to remove these lines:

Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Custom Contact List").Delete
Application.DisplayAlerts = True
Set wksContact = ThisWorkbook.Worksheets.Add
wksContact.Name = "Custom Contact List"

If this is to be a general procedure (one used several times while writing to different worksheets) you may want to supply the worksheet as a parameter to the Sub. Example:

Sub BuildList(ByVal wksList As Worksheet)

Then in the body of the Sub you would replace references to wksContact with wksList. This allows you to pass a worksheet from another workbook to the BuildList procedure. Here is an example of how you would call this:

BuildList Workbooks("ProjectName_TestScript").Worksheets("Overview")

To append the list being built to an existing list, you will need to calculate the end of the existing list, in the same manner I calculated

LastUsedRow

, but you would do so on wksList keying on the appropriate column and assign this to a new variable (e.g. EndOfList). You would then replace this line:

wksContact.Cells(HeaderRowNum + ListCount, 1).PasteSpecial Paste:=xlPasteValues

with something like:

wksList.Cells(EndOfList + ListCount, 1).PasteSpecial Paste:=xlPasteValues

Hopefully, this is enough to get you started. Post back with how you're progressing or if you have other questions.

Regards,
Mike

 

[dmorri254]

Mike ...again thank you so much....if you like if you e-mail me at this address..david.morrison@abnamro.com, I can send you a copy of the workbook so you can get a clear picture of what I am working on...

David