• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

getting macro to work if multiple cells are filled with values

runway

New Member
Hi,


Some time ago one of you gents put together some VBA which did the job it needed to do.

But now I was hoping I could get some more help with it. The attached file is more explanatory but basically the code works fine if I put a value in each cell one by one. Want I want to do is copy/paste several values at once and have the vba react accordingly. At present I have to F2 into each cell containing a value and hit enter if I copy/paste a long column of values.


Any help appreciated.


Thanks


http://www.mediafire.com/?3s56v6s4cdlmi4f
 
Modifying the macro as it was posted on:

http://chandoo.org/forums/topic/autofill-a-rrange-based-on-value-entered-in-a-different-cell

I've included a loop to go through each cell within Target (aka, the range the was changed) and run the macro for that cell. I'm afraid you'll need to make the same modifications you did before, but hopefully that is not too painful.

[pre]
Code:
Option Explicit
Const TRAPCELLS = "B2:B6"
Const LOOKUPCELLS = "B11:B14"
Const SHIFTCOLUMNS = 10

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sourceRow As Integer
Dim copyRange As Range
Dim C As Range

For Each C In Target 'Loops through all the cells within Target Range
If Not Intersect(C, Range(TRAPCELLS)) Is Nothing Then
On Error Resume Next
sourceRow = Application.WorksheetFunction.Match(C, Range(LOOKUPCELLS), 0)
On Error GoTo 0 'Always good practice to reset your On Error command
If sourceRow = 0 Then Exit Sub
Set copyRange = Range(LOOKUPCELLS).Cells(1, 1).Offset(sourceRow - 1, 1)
Set copyRange = Range(copyRange, copyRange.Offset(0, SHIFTCOLUMNS - 1))
copyRange.Copy
C.Offset(0, 1).PasteSpecial
Application.CutCopyMode = False
C.Offset(1, 0).Select
End If
Next C
End Sub
[/pre]
 
Fantastic. It just works.....

It is 22:45 here and I have been at work since 11:30 this morning. I can see what you changed but I am not going to try and work out why it works now until tomorrow.

Please be assured I will work it out and learn from this.

Thank you for your time!


Oh You Guys,,,,,

You make me all warm and cuddly feeling.....

:-D
 
Back
Top