ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   InputBox doesn't allow non adjacent rows (https://www.excelbanter.com/excel-programming/425097-inputbox-doesnt-allow-non-adjacent-rows.html)

Steve[_16_]
InputBox doesn't allow non adjacent rows
 
I have the below procedure which allows me to select a range on 1
sheet and copy each row in that range 10 times, before moving on to
the next row. The Application.InputBox method allows me to select
multiple rows if they are adjacent, but it only copies the first
selected row when the selection contains non-adjacent rows. Is there a
work around to this?

Thanks in advance for any assistance...

<-------------------------------------------------------------------------------------------------------------------------


Sub CopySelection10Times()

Dim myRange As Range
Dim rng As Range
Dim i As Long
Dim wksto As Worksheet

On Error Resume Next
Set wksto = ThisWorkbook.Sheets("Metro AHK New")
Set myRange = Application.InputBox("Select data to
copy", , , , , , , 8)

If myRange Is Nothing Then
Exit Sub
Else
End If

For i = 1 To myRange.Rows.Count
myRange.Rows(i).EntireRow.Copy wksto.Cells(wksto.Rows.Count, _
1).End(xlUp).Offset
(1, 0).Resize(10, wksto.Columns.Count)
Next

Application.CutCopyMode = False

End Sub

[email protected]
InputBox doesn't allow non adjacent rows
 
On Mar 5, 11:14*am, Steve wrote:
I have the below procedure which allows me to select a range on 1
sheet and copy each row in that range 10 times, before moving on to
the next row. The Application.InputBox method allows me to select
multiple rows if they are adjacent, but it only copies the first
selected row when the selection contains non-adjacent rows. Is there a
work around to this?

Thanks in advance for any assistance...

<-------------------------------------------------------------------------------------------------------------------------



Sub CopySelection10Times()

* * Dim myRange As Range
* * Dim rng As Range
* * Dim i As Long
* * Dim wksto As Worksheet

* * On Error Resume Next
* * Set wksto = ThisWorkbook.Sheets("Metro AHK New")
* * Set myRange = Application.InputBox("Select data to
copy", , , , , , , 8)

* * * * If myRange Is Nothing Then
* * * * * * Exit Sub
* * * * * * Else
* * * * End If

* * For i = 1 To myRange.Rows.Count
* * * * myRange.Rows(i).EntireRow.Copy wksto.Cells(wksto.Rows.Count, _
* * * * * * * * * * * * * * * * * * * * * * * * * *1).End(xlUp).Offset
(1, 0).Resize(10, wksto.Columns.Count)
* * Next

* * Application.CutCopyMode = False

End Sub

Steve,

See if this will do the trick for you.

Best,

Matt

Sub CopySelection10Times()

Dim myRange As Range
Dim rng As Range
Dim strNewRange As String
Dim i As Long
Dim j As Long
Dim wksto As Worksheet
Dim lngRangeCount As Long
Dim testVar

On Error Resume Next
Set wksto = ThisWorkbook.Sheets("Metro AHK New")
Set myRange = Application.InputBox("Select data to Copy
", , , , , , , 8)

If myRange Is Nothing Then
Exit Sub
Else
End If

lngRangeCount = UBound(Split(myRange.Address, ","))
Debug.Print lngRangeCount

For i = 0 To lngRangeCount

strNewRange = Split(myRange.Address, ",")(i)

Set rngLoopRange = Range(strNewRange)

If rngLoopRange Is Nothing Then
Set rngLoopRange = myRange
End If

Debug.Print rngLoopRange.Address

For j = 1 To myRange.Rows.Count
myRange.Rows(i).EntireRow.Copy wksto.Cells
(wksto.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(10,
wksto.Columns.Count)
Next
Next

Application.CutCopyMode = False

End Sub

PA
InputBox doesn't allow non adjacent rows
 
To loop through all the areas selected, try the following:

Sub test()
Dim rngCell As Range
Dim rngAreas As Areas
Dim rngArea As Range
Set rngAreas = Selection.Areas

For Each rngArea In rngAreas
For Each rngCell In rngArea
rngCell = rngCell.Address
Next
Next

End Sub

PA

" wrote:

On Mar 5, 11:14 am, Steve wrote:
I have the below procedure which allows me to select a range on 1
sheet and copy each row in that range 10 times, before moving on to
the next row. The Application.InputBox method allows me to select
multiple rows if they are adjacent, but it only copies the first
selected row when the selection contains non-adjacent rows. Is there a
work around to this?

Thanks in advance for any assistance...

<-------------------------------------------------------------------------------------------------------------------------



Sub CopySelection10Times()

Dim myRange As Range
Dim rng As Range
Dim i As Long
Dim wksto As Worksheet

On Error Resume Next
Set wksto = ThisWorkbook.Sheets("Metro AHK New")
Set myRange = Application.InputBox("Select data to
copy", , , , , , , 8)

If myRange Is Nothing Then
Exit Sub
Else
End If

For i = 1 To myRange.Rows.Count
myRange.Rows(i).EntireRow.Copy wksto.Cells(wksto.Rows.Count, _
1).End(xlUp).Offset
(1, 0).Resize(10, wksto.Columns.Count)
Next

Application.CutCopyMode = False

End Sub

Steve,

See if this will do the trick for you.

Best,

Matt

Sub CopySelection10Times()

Dim myRange As Range
Dim rng As Range
Dim strNewRange As String
Dim i As Long
Dim j As Long
Dim wksto As Worksheet
Dim lngRangeCount As Long
Dim testVar

On Error Resume Next
Set wksto = ThisWorkbook.Sheets("Metro AHK New")
Set myRange = Application.InputBox("Select data to Copy
", , , , , , , 8)

If myRange Is Nothing Then
Exit Sub
Else
End If

lngRangeCount = UBound(Split(myRange.Address, ","))
Debug.Print lngRangeCount

For i = 0 To lngRangeCount

strNewRange = Split(myRange.Address, ",")(i)

Set rngLoopRange = Range(strNewRange)

If rngLoopRange Is Nothing Then
Set rngLoopRange = myRange
End If

Debug.Print rngLoopRange.Address

For j = 1 To myRange.Rows.Count
myRange.Rows(i).EntireRow.Copy wksto.Cells
(wksto.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(10,
wksto.Columns.Count)
Next
Next

Application.CutCopyMode = False

End Sub

Steve[_16_]
InputBox doesn't allow non adjacent rows
 
Thanks Bill.

However; this copies the wrong rows. If I select rows 10 & 20, it
copies 9 &10.


On Mar 5, 11:40*am, wrote:
On Mar 5, 11:14*am, Steve wrote:



I have the below procedure which allows me toselecta range on 1
sheet and copy each row in that range 10 times, before moving on to
the next row. The Application.InputBox method allows me toselect
multiplerows if they are adjacent, but it only copies the first
selected row when the selection contains non-adjacent rows. Is there a
work around to this?

Thanks in advance for any assistance...

<-------------------------------------------------------------------------------------------------------------------------

Sub CopySelection10Times()

* * Dim myRange As Range
* * Dim rng As Range
* * Dim i As Long
* * Dim wksto As Worksheet

* * On Error Resume Next
* * Set wksto = ThisWorkbook.Sheets("Metro AHK New")
* * Set myRange = Application.InputBox("Selectdata to
copy", , , , , , , 8)

* * * * If myRange Is Nothing Then
* * * * * * Exit Sub
* * * * * * Else
* * * * End If

* * For i = 1 To myRange.Rows.Count
* * * * myRange.Rows(i).EntireRow.Copy wksto.Cells(wksto.Rows.Count, _
* * * * * * * * * * * * * * * * * * * * * * * * * *1).End(xlUp).Offset
(1, 0).Resize(10, wksto.Columns.Count)
* * Next

* * Application.CutCopyMode = False

End Sub

Steve,

See if this will do the trick for you.

Best,

Matt

Sub CopySelection10Times()

* * Dim myRange As Range
* * Dim rng As Range
* * Dim strNewRange As String
* * Dim i As Long
* * Dim j As Long
* * Dim wksto As Worksheet
* * Dim lngRangeCount As Long
* * Dim testVar

* * On Error Resume Next
* * Set wksto = ThisWorkbook.Sheets("Metro AHK New")
* * Set myRange = Application.InputBox("Selectdata to Copy
", , , , , , , 8)

* * * * If myRange Is Nothing Then
* * * * * * Exit Sub
* * * * * * Else
* * * * End If

* * lngRangeCount = UBound(Split(myRange.Address, ","))
* * * * Debug.Print lngRangeCount

* * For i = 0 To lngRangeCount

* * * * strNewRange = Split(myRange.Address, ",")(i)

* * * * Set rngLoopRange = Range(strNewRange)

* * * * If rngLoopRange Is Nothing Then
* * * * * * Set rngLoopRange = myRange
* * * * End If

* * * * Debug.Print rngLoopRange.Address

* * * * For j = 1 To myRange.Rows.Count
* * * * * * myRange.Rows(i).EntireRow.Copy wksto.Cells
(wksto.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(10,
wksto.Columns.Count)
* * * * Next
* * Next

* * Application.CutCopyMode = False

End Sub

Steve[_16_]
InputBox doesn't allow non adjacent rows
 
Sorry, I meant Matt...

On Mar 5, 2:47*pm, Steve wrote:
Thanks Bill.

However; this copies the wrong rows. If I select rows 10 & 20, it
copies 9 &10.

On Mar 5, :

On Mar 5, 11:14*am, Steve wrote:

I have the below procedure which allows me toselecta range on 1
sheet and copy each row in that range 10 times, before moving on to
the next row. The Application.InputBox method allows me toselect
multiplerows if they are adjacent, but it only copies the first
selected row when the selection contains non-adjacent rows. Is there a
work around to this?

Thanks in advance for any assistance...

<-------------------------------------------------------------------------------------------------------------------------

Sub CopySelection10Times()

* * Dim myRange As Range
* * Dim rng As Range
* * Dim i As Long
* * Dim wksto As Worksheet

* * On Error Resume Next
* * Set wksto = ThisWorkbook.Sheets("Metro AHK New")
* * Set myRange = Application.InputBox("Selectdata to
copy", , , , , , , 8)

* * * * If myRange Is Nothing Then
* * * * * * Exit Sub
* * * * * * Else
* * * * End If

* * For i = 1 To myRange.Rows.Count
* * * * myRange.Rows(i).EntireRow.Copy wksto.Cells(wksto.Rows..Count, _
* * * * * * * * * * * * * * * * * * * * * * * * * *1).End(xlUp).Offset
(1, 0).Resize(10, wksto.Columns.Count)
* * Next

* * Application.CutCopyMode = False

End Sub

Steve,

See if this will do the trick for you.

Best,

Matt

Sub CopySelection10Times()

* * Dim myRange As Range
* * Dim rng As Range
* * Dim strNewRange As String
* * Dim i As Long
* * Dim j As Long
* * Dim wksto As Worksheet
* * Dim lngRangeCount As Long
* * Dim testVar

* * On Error Resume Next
* * Set wksto = ThisWorkbook.Sheets("Metro AHK New")
* * Set myRange = Application.InputBox("Selectdata to Copy
", , , , , , , 8)

* * * * If myRange Is Nothing Then
* * * * * * Exit Sub
* * * * * * Else
* * * * End If

* * lngRangeCount = UBound(Split(myRange.Address, ","))
* * * * Debug.Print lngRangeCount

* * For i = 0 To lngRangeCount

* * * * strNewRange = Split(myRange.Address, ",")(i)

* * * * Set rngLoopRange = Range(strNewRange)

* * * * If rngLoopRange Is Nothing Then
* * * * * * Set rngLoopRange = myRange
* * * * End If

* * * * Debug.Print rngLoopRange.Address

* * * * For j = 1 To myRange.Rows.Count
* * * * * * myRange.Rows(i).EntireRow.Copy wksto.Cells
(wksto.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(10,
wksto.Columns.Count)
* * * * Next
* * Next

* * Application.CutCopyMode = False

End Sub

[email protected]
InputBox doesn't allow non adjacent rows
 
On Mar 5, 3:33*pm, Steve wrote:
Sorry, I meant Matt...

On Mar 5, 2:47*pm, Steve wrote:

Thanks Bill.

However; this copies the wrong rows. If I select rows 10 & 20, it
copies 9 &10.

On Mar 5, :

On Mar 5, 11:14*am, Steve wrote:

I have the below procedure which allows me toselecta range on 1
sheet and copy each row in that range 10 times, before moving on to
the next row. The Application.InputBox method allows me toselect
multiplerows if they are adjacent, but it only copies the first
selected row when the selection contains non-adjacent rows. Is there a
work around to this?

Thanks in advance for any assistance...

<-------------------------------------------------------------------------------------------------------------------------

Sub CopySelection10Times()

* * Dim myRange As Range
* * Dim rng As Range
* * Dim i As Long
* * Dim wksto As Worksheet

* * On Error Resume Next
* * Set wksto = ThisWorkbook.Sheets("Metro AHK New")
* * Set myRange = Application.InputBox("Selectdata to
copy", , , , , , , 8)

* * * * If myRange Is Nothing Then
* * * * * * Exit Sub
* * * * * * Else
* * * * End If

* * For i = 1 To myRange.Rows.Count
* * * * myRange.Rows(i).EntireRow.Copy wksto.Cells(wksto.Rows.Count, _
* * * * * * * * * * * * * * * * * * * * * * * * * *1).End(xlUp).Offset
(1, 0).Resize(10, wksto.Columns.Count)
* * Next

* * Application.CutCopyMode = False

End Sub

Steve,

See if this will do the trick for you.

Best,

Matt

Sub CopySelection10Times()

* * Dim myRange As Range
* * Dim rng As Range
* * Dim strNewRange As String
* * Dim i As Long
* * Dim j As Long
* * Dim wksto As Worksheet
* * Dim lngRangeCount As Long
* * Dim testVar

* * On Error Resume Next
* * Set wksto = ThisWorkbook.Sheets("Metro AHK New")
* * Set myRange = Application.InputBox("Selectdata to Copy
", , , , , , , 8)

* * * * If myRange Is Nothing Then
* * * * * * Exit Sub
* * * * * * Else
* * * * End If

* * lngRangeCount = UBound(Split(myRange.Address, ","))
* * * * Debug.Print lngRangeCount

* * For i = 0 To lngRangeCount

* * * * strNewRange = Split(myRange.Address, ",")(i)

* * * * Set rngLoopRange = Range(strNewRange)

* * * * If rngLoopRange Is Nothing Then
* * * * * * Set rngLoopRange = myRange
* * * * End If

* * * * Debug.Print rngLoopRange.Address

* * * * For j = 1 To myRange.Rows.Count
* * * * * * myRange.Rows(i).EntireRow.Copy wksto.Cells
(wksto.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(10,
wksto.Columns.Count)
* * * * Next
* * Next

* * Application.CutCopyMode = False

End Sub

I simply wrote the code rather than actually testing it; my mistake
for the error. The "myRange." in the second For Loop should be
replaced with "rngLoopRange.". See below.

Matt

For j = 1 To rngLoopRange.Rows.Count
rngLoopRange.Rows(i).EntireRow.Copy wksto.Cells
(wksto.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(10,
wksto.Columns.Count)
Next


All times are GMT +1. The time now is 01:12 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com