I had an excellent solution to copy to row 29 and not further down than row 49 in a particular column.

Each copy goes to the next empty row in that range.

This is what I saved as an archive, but I did not make proper comments to refresh my memory on making it work again.

With wksTarget
FERow = WorksheetFunction.Max(29, .Cells(49, 1).End(xlUp).Offset(1, 0).Row)
.Cells(FERow, 1).Resize(columnsize:=4) = varRicho
End With

I am guessing that I was using it an event macro and with an array varRicho.

I would like to recapture how that works both with an plain "copy to" and with an array example.

Thanks,

Howard

Hi Howard,

Am Fri, 31 Jul 2015 04:50:29 -0700 (PDT) schrieb L. Howard:

With wksTarget
FERow = WorksheetFunction.Max(29, .Cells(49, 1).End(xlUp).Offset(1, 0).Row)
.Cells(FERow, 1).Resize(columnsize:=4) = varRicho
End With

I remember but I cannot find it in the archive.
Here a snippet with array. If the array has more items than 21 the items
will then written to column B and so on:

Sub Test()
Dim FERow As Long, i As Long, myCol As Long
Dim varData As Variant

With ActiveSheet
varData = .Range("E1:E30")
myCol = 1
For i = LBound(varData) To UBound(varData)
FERow = WorksheetFunction.Max(29, .Cells(49,
myCol).End(xlUp).Offset(1, 0).Row)
.Cells(FERow, myCol) = varData(i, 1)
If i = 22 Then
myCol = myCol + 1
End If
Next
End With
End Sub

If that's not the expected suggestion please explain a little further.
What do you want to copy? A single cell or a range? What should happen
if the range has more than 21 items?


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

If that's not the expected suggestion please explain a little further.
What do you want to copy? A single cell or a range? What should happen
if the range has more than 21 items?


Regards
Claus B.

Hi Claus,

That is an excellent example for an array.

Another non array situation would be to FIND the value "eex4" or a serial number 1122 (a string or a Long) in column E1:En and return the data from E to the right any given number of columns. Where the data associated with "eex4" may be six columns across and "eex9" only has three columns of data. These would then be copied to A29 and A30.

If more than 21 items an error or alert message "Exceeding Range Blah Blah"
(The spill over to column B in the array code is good to have also. So that example can stay with the array code)

Howard

Hi Howard,

Am Fri, 31 Jul 2015 07:07:36 -0700 (PDT) schrieb L. Howard:

Another non array situation would be to FIND the value "eex4" or a serial number 1122 (a string or a Long) in column E1:En and return the data from E to the right any given number of columns. Where the data associated with "eex4" may be six columns across and "eex9" only has three columns of data. These would then be copied to A29 and A30.

try it with:

Sub Copy()
Dim FERow As Long, LRow As Long, LCol As Long
Dim c As Range

With ActiveSheet
FERow = WorksheetFunction.Max(29, .Cells(49, 1).End(xlUp).Offset(1,
0).Row)
LRow = .Cells(Rows.Count, 5).End(xlUp).Row
Set c = .Range("E1:E" & LRow).Find("eex4", LookIn:=xlValues,
lookat:=xlWhole)
If Not c Is Nothing Then
LCol = .Cells(c.Row, Columns.Count).End(xlToLeft).Column
If FERow = 50 Then
.Cells(FERow, 1).Resize(columnsize:=LCol - 4).Value = _
.Range(.Cells(c.Row, 5), .Cells(c.Row, LCol)).Value
Else
MsgBox "Exceeding Range"
End If
End If
End With
End Sub

If eex4 could appear more than once you have to do it with FindNext


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi again,

Am Fri, 31 Jul 2015 16:30:03 +0200 schrieb Claus Busch:

try it with:

Sub Copy()

better try:

Sub Copy()
Dim FERow As Long, LRow As Long, LCol As Long
Dim c As Range

With ActiveSheet
FERow = WorksheetFunction.Max(29, .Cells(Rows.Count,
1).End(xlUp).Offset(1, 0).Row)
If FERow 49 Then
MsgBox "Exceeding Range"
Exit Sub
End If
LRow = .Cells(Rows.Count, 5).End(xlUp).Row
Set c = .Range("E1:E" & LRow).Find("eex4", LookIn:=xlValues,
lookat:=xlWhole)
If Not c Is Nothing Then
LCol = .Cells(c.Row, Columns.Count).End(xlToLeft).Column
.Cells(FERow, 1).Resize(columnsize:=LCol - 4).Value = _
.Range(.Cells(c.Row, 5), .Cells(c.Row, LCol)).Value
End If
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Friday, July 31, 2015 at 7:50:02 AM UTC-7, Claus Busch wrote:
Hi again,

Am Fri, 31 Jul 2015 16:30:03 +0200 schrieb Claus Busch:

try it with:

Sub Copy()

better try:

Sub Copy()
Dim FERow As Long, LRow As Long, LCol As Long
Dim c As Range

With ActiveSheet
FERow = WorksheetFunction.Max(29, .Cells(Rows.Count,
1).End(xlUp).Offset(1, 0).Row)
If FERow 49 Then
MsgBox "Exceeding Range"
Exit Sub
End If
LRow = .Cells(Rows.Count, 5).End(xlUp).Row
Set c = .Range("E1:E" & LRow).Find("eex4", LookIn:=xlValues,
lookat:=xlWhole)
If Not c Is Nothing Then
LCol = .Cells(c.Row, Columns.Count).End(xlToLeft).Column
.Cells(FERow, 1).Resize(columnsize:=LCol - 4).Value = _
.Range(.Cells(c.Row, 5), .Cells(c.Row, LCol)).Value
End If
End With
End Sub

This works quite well, and I will keep the other non array code also. I did have to change this If FERow = 50 Then to If FERow < 50 Then.

I assume that was a typo, as it works in the brief test I did.

Good stuff, as always, I thank you Claus.

I'll be sure to make sufficient notes on these codes, and with the whole macros intact in a workbook example that will help.

Thanks again.

Howard

Hi Howard,

Am Fri, 31 Jul 2015 09:07:00 -0700 (PDT) schrieb L. Howard:

This works quite well, and I will keep the other non array code also. I did have to change this If FERow = 50 Then to If FERow < 50 Then.

always glad to help.

But FERow is always <50 if it is not exactly 50.
If FERow is <=49 you can copy & paste. If FERow becomes 50 you get the
message box.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Friday, July 31, 2015 at 9:13:22 AM UTC-7, Claus Busch wrote:
Hi Howard,

Am Fri, 31 Jul 2015 09:07:00 -0700 (PDT) schrieb L. Howard:

This works quite well, and I will keep the other non array code also. I did have to change this If FERow = 50 Then to If FERow < 50 Then.

always glad to help.

But FERow is always <50 if it is not exactly 50.
If FERow is <=49 you can copy & paste. If FERow becomes 50 you get the
message box.


Regards
Claus B.

Well, that make sense for sure. I'll revert it back to what you had.

Thanks.

Howard

Hi Claus,

With the array code I am trying to do a transpose the column to row within the row-29 to row-49 range.

Here is where I am now, but cannot get past the Re Dim...

Howard

Sub Test_29_49_Array_XPose()
Dim FERow As Long, i As Long, myCol As Long
Dim varData As Variant
Dim eRng As Range

With ActiveSheet

varData = .Range("E1", Range("E1").End(xlDown))

For Each eRng In varData
ReDim Preserve varData(varData.Cells.Count - 1)
varData(i) = eRng
i = i + 1
Next

myCol = 1

FERow = WorksheetFunction.Max(29, .Cells(49, myCol).End(xlUp).Offset(1, 0).Row)

Cells(FERow, myCol).Resize(columnsize:=varData.Cells.Count) = Application.Transpose(varData)

End With

End Sub

Hi Howard,

Am Fri, 31 Jul 2015 22:50:02 -0700 (PDT) schrieb L. Howard:

With the array code I am trying to do a transpose the column to row within the row-29 to row-49 range.

Here is where I am now, but cannot get past the Re Dim...

I hope I understood your problem.

Sub Test_29_49_Array_XPose()
Dim FERow As Long, LRow As Long
Dim varData As Variant

With ActiveSheet
LRow = .Cells(Rows.Count, "E").End(xlUp).Row
varData = .Range("E1:E" & LRow)

FERow = WorksheetFunction.Max(29, .Cells(Rows.Count,
1).End(xlUp).Offset(1, 0).Row)

If FERow = 50 Then
MsgBox "Exceed Range"
Exit Sub
End If

Cells(FERow, 1).Resize(columnsize:=UBound(varData)) =
Application.Transpose(varData)
End With

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

I hope I understood your problem.

Sub Test_29_49_Array_XPose()
Dim FERow As Long, LRow As Long
Dim varData As Variant

With ActiveSheet
LRow = .Cells(Rows.Count, "E").End(xlUp).Row
varData = .Range("E1:E" & LRow)

FERow = WorksheetFunction.Max(29, .Cells(Rows.Count,
1).End(xlUp).Offset(1, 0).Row)

If FERow = 50 Then
MsgBox "Exceed Range"
Exit Sub
End If

Cells(FERow, 1).Resize(columnsize:=UBound(varData)) =
Application.Transpose(varData)
End With

End Sub


Regards
Claus B.

Yes, that is it. Just wanted a macro example of the transpose function to work within the 29 -- 49 row range.

Thanks again.

Howard