excel - copy row based on cell value 1

[cc4mail]

This has come up a few times in the forum without an answer (eg thread68_412048). I have the same problem.

Based on a cell value on sheet1, I want to copy a specific row range on sheet2 to sheet1 at a selected location.

The logic is correct, but I'm having a problem with the range. Can u help?

I want to call CopyRow onChange of specific cells on sheet1
(b21,b23,b25,b27,b29) and replace rows relative to the changed cell..



Sub CopyRow()
Dim varRow As Integer
Dim varCol As Integer
Dim varSel As Integer

varRow = Selection.row
varSel = Selection.Value
varCol = 3

' valid values 1 thru 7

Worksheets("Sheet2&quot.Select
Select Case varSel
Case 1
Worksheets("Sheet2&quot.Range("B6", "AD6&quot.Copy
Case 2
Worksheets("Sheet2&quot.Range("B8", "AD8&quot.Copy
Case 3
Worksheets("Sheet2&quot.Range("B10", "AD10&quot.Copy
Case 4
Worksheets("Sheet2&quot.Range("B12", "ADd12&quot.Copy
Case 5
Worksheets("Sheet2&quot.Range("B14", "AD14&quot.Copy
Case 6
Worksheets("Sheet2&quot.Range("B16", "AD16&quot.Copy
Case 7
Worksheets("Sheet2&quot.Range("B18", "AD18&quot.Copy
Case Else
MsgBox ("Incorrect value&quot
End Select

Worksheets("Sheet1&quot.Select
Worksheets("Sheet1&quot.Cells(varRow + 1, varCol).Select
Worksheets("Sheet1&quot.Paste
End Sub

 

[SkipVought]

cc,

It works. Just made a few clean-up changes

Sub CopyRow()
    Dim varRow As Integer
    Dim varCol As Integer
    Dim varSel As Integer
    
    With Selection
        varRow = .Row
        varSel = .Value
        varCol = 3
    End With
    
' valid values 1 thru 7
    
   With Worksheets("Sheet2")
    Select Case varSel
         Case 1
             .Range("B6", "AD6").Copy
         Case 2
             .Range("B8", "AD8").Copy
         Case 3
             .Range("B10", "AD10").Copy
         Case 4
             .Range("B12", "ADd12").Copy
         Case 5
             .Range("B14", "AD14").Copy
         Case 6
             .Range("B16", "AD16").Copy
         Case 7
             .Range("B18", "AD18").Copy
         Case Else
             MsgBox ("Incorrect value")
             Exit Sub
     End Select
    End With
    With Worksheets("Sheet1")
        .Paste (.Cells(varRow + 1, varCol))
    End With
End Sub

Don't need to select et al.



Skip,

http://www.TheOfficeExperts.com

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[cc4mail]

SKIP,

GAVE IT A WHIRL, BUT GOT WORKSHEETS(&quot;SHEET2&quot=<SUBSCRIPT OUT OF RANGE>&quot; yet in debug, the variable values are correct?

( I also took care of the typo in Case 4)

This is a project in excel 97, that's why I used the select. Is this an issue?

Craig

 

[SkipVought]

Then you don't have a sheet named &quot;Sheet2&quot;

I am also using Excel 97



Skip,

http://www.TheOfficeExperts.com

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[cc4mail]

oops, the space between sheet 2 killed it, but didn't effect &quot;sheet1&quot;

Well, it works great!. This was asked a few times in the forum, but never a satisfactory answer. No one seemed to know.

Additionally...

Is there a quick way to call CopyRow on_change to any of a specific group of cells (b21,b23,b25,b27,b29) without necessarly having to tab out? for instance a on_keypress ?


Thanks for your help. It saved a lot of frustration and time. Big star from me!

Craig

 

[SkipVought]

So if any of b21,b23,b25,b27,b29 is CHANGED, you want the sub fired.

Paste this in the SHEET OBJECT (right click sheet tab and select vies code)

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rng As Range
    Set rng = Application.Intersect(Target, Union(Range("b21"), Range("b23"), Range("b25"), Range("b27"), Range("b29")))
    If Not rng Is Nothing Then
       CopyRow
    End If
End Sub

Skip,

http://www.TheOfficeExperts.com

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[cc4mail]

Wow, Skip thanks,

Not only would I not have figured it out, I wouldn't know where to start. My attempts were nothing close.

Your help is greatly appreciated! If my employer wasn't so backwards, they would hire real knowledge, instead they rely of people like me to do it in a very amateur manner using every application and development tool imaginable. Slow, inefficient and counter-productive.

A word to all the tech users out there - keep trying, but use/hire real experts like Skip to solve problems - saves a lot of headaches.


Thanks!

Craig