Need help creating Loop

[Guest]

Hello,

I've set up a Macro to port completed data (meaning a line/row of data) to
another page "OMNI". The sheet is formatted so there are 46 rows of data and
this is my "catch area" (formatted page that has headings in column A as well
as row 1 & 2. It needs to be this way since some data stays here until it's
expired and all is calculated on row 47. For every line that is moved to the
"OMNI", a new line must be entered but the rest of the data pushed up so
there is not just a blank line.

I'm looking for a Loop Macro to do the same thing as I've tried to achieve
in the Macro below. Currently, I am using a Target Value and once the box in
that named row is touched, the line will automatically copy and paste to
another sheet in my workbook. This works, but is not the best way to go
since people using this spreadsheet might accidentally touch this row and
than the data is moved prematurely.

Below is both an example of my current Macro and an example of my excel table.

Thank you for your thoughts - Jenny B.

__________________________________________________________________________
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("b3")) Is Nothing Then
Sheets("omni").Range("a3:ac3").Insert Shift:=xlDown
Range("d3:ad3").Copy Destination:=Sheets("omni").Range("a3:aa3")
Range("C3:AE3").Select
Selection.Delete Shift:=xlUp
Range("C45:AE45").Select
Selection.Insert Shift:=xlDown
ActiveWindow.ScrollRow = 3
Range("d3").Select
ElseIf Not Intersect....................................<and so on and so on
through Range("b46")>

______________________________________________________________
A B C D
E F.....<all the way to AE>
Date Company Div Group Response Rate
TAT Reports

1 1/1/2007 Paint Division IT 72%
7 8

2 2/1/2006 Electronics C&G 51%
8 23

3 3/1/2007 Automotive Trans 63%
9 25

4

""
""
47 (row 47 used to Avg certain columns) <Cell Avgs all Response Rates>
<Cell Avgs Turn Around> <Cell Avgs Number of Reports>

 

[Guest]

I think you can shorten this up a lot, although since you've already got it
written?...

First, go ahead and test for the intersect all at once:
If Not Intersect(Target,Range("B3:B46")) Is Nothing

You'll next need to make sure they haven't selected some several rows, or
several columns that included one of your cells:
If Target.Cells.Count > 1 Then
Exit Sub
End If
at this point you know they selected a single cell in column B within rows 3
through 46
set up a variable to hold the row number earlier as
Dim hotRow as Integer

and after that last test, 'capture' the row number
hotRow = Target.Row

From here on you could reduce all of your code sections dealing with each
possible row to create formulas using the 'hotRow' value and a couple of
other string variables
Dim anyRange1 as String
Dim anyRange2 as String

anyRange1 = "A" & hotRow & ":AC" & hotRow
used as
Sheets("omni").Range(anyRange1).Insert Shift:=xlDown

and the pair as
anyRange1 = "D" & hotRow & ":AD" & hotRow
anyRange2 = ""A" & hotRow & ":AA" & hotRow
Range(anyRange1).Copy Destination:=Sheets("omni").Range(anyRange2)


Now, about your problem with people selecting one of the B3:B46 cells too
soon - you could put all of the code into the worksheet's
_BeforeDoubleClick() routine, with instructions of course to double-click to
move the data. Everything would be the same except you'd want to add a
Cancel = True
statement into the code.

Another way is if you know how many cells in the row should/must have
information in them before a move is valid you can set up a test of that
range to see if "the count's right". Say in columns D:AD on the row(s) each
cell must have something in it, giving a requirement to have 27 non-empty
cells:
Dim filledCells as Integer
Dim testRange as Range
Dim anyCell as Object
filledCells=0 ' just to be sure
anyRange1 = "D" & hotRow & ":AD" & hotRow
Set testRange = Worksheets("SheetName").Range(anyRange1)
For each anyCell in testRange
If Not(IsEmpty(anyCell)) Then
filledCells=filledCells + 1
End If
Next
If filledCells <> 27 Then
Exit Sub ' not all data entered yet
End If

Hope all of this helps you some and at least gives you some ideas on how to
proceed.

 

[Guest]

Thank you so very much for the excellent support!

This has helped me size down this clunky code and head in a better more
efficient direction.

Regards - Jenny B.

 

[Guest]

You're very welcome.

Thank you so very much for the excellent support!

This has helped me size down this clunky code and head in a better more
efficient direction.

Regards - Jenny B.