Want to get New Row position of firstRow of Range after combining two or multiple ranges repeatedly

SamDsouza

Board Regular
Joined
Apr 16, 2016
Messages
205
Hello
How can i get new First Row position for New Range.
on basis of Rows.Count to some extent i was able to combine Two Ranges at a particular Rows.
But to get the same 3 or 5 times at every NewRow Position for two ranges as per below coding repeating it seemed bit difficult
Also if more ranges added then Rows.Count for more ranges could differ and may not be the same . Your suggestion will be appreciated

VBA Code:
Private Sub Workbook_Open()
Dim lastRow As Long, rowsCnt As Long, i As Integer, FirstRowRange As Long, EndRowRange As Long, FirstNewRowRange As Long ', firstRow As Long
Dim lastNewRowRange As Long, newrowsCnt As Long, j As Integer, xFirstRow As Long
Dim firstRow as Long:  firstRow = 4

Dim wks As Worksheet
Set wks = Worksheets("Sheet1")
 
rowsCnt = wks.Range("A4:F9").Rows.Count
newrowsCnt = wks.Range("A10:F17").Rows.Count

EndRowRange = firstRow + rowsCnt - 1
FirstNewRowRange = EndRowRange + 1
lastNewRowRange = FirstNewRowRange + newrowsCnt - 1

MsgBox "Rows Count From A4:F9 = " & rowsCnt & " New Rows Range Count from A10:F17 = " & newrowsCnt & vbCrLf & _
"First Row : " & firstRow & "  Last Row " & EndRowRange & vbCrLf & _
"FirstNewRowRange : " & FirstNewRowRange & "  LastNewRowRange : " & lastNewRowRange

For i = firstRow To EndRowRange
      wks.Range("B" & i & ":F" & i).Value = "SAM"
Next i

For i = FirstNewRowRange To lastNewRowRange
      wks.Range("B" & i & ":F" & i).Value = "DSOUZA"
Next i
lastNewRowRange = lastNewRowRange + 1

End Sub
Thanks SamDsouza
112
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Hi, Maybe you could utilise the Range.Areas property to do what you want



Not fully tested but have a play with this update to your code & see if will help you

VBA Code:
Sub Workbook_Open()
    Dim wks As Worksheet
    Dim rng As Range
    Dim FirstRow As Long, LastRow As Long
    Dim rowsCnt As Long
    Dim i As Integer
    
    
    Set wks = Worksheets("Sheet1")
     
    Set rng = wks.Range("A4:F9,A10:F17")
    
    For i = 1 To rng.Areas.Count
        rowsCnt = rng.Areas(i).Rows.Count
        FirstRow = rng.Areas(i).Cells(1, 1).Row
        LastRow = rng.Areas(i)(rng.Areas(i).Cells.Count).Row
        
        MsgBox "AREA " & i & Chr(10) & _
        "Rows Count From " & rng.Areas(i).Address(0, 0) & " = " & rowsCnt & Chr(10) & _
        "First Row : " & FirstRow & Chr(10) & _
        "Last Row " & LastRow
        
        rng.Offset(, 1).Areas(i).Value = Choose(i, "SAM", "DSOUZA")
    Next
    
End Sub

To expand the Range Areas just include the Addresses as required in this line

VBA Code:
Set rng = wks.Range("A4:F9,A10:F17")


Hope helpful

Dave
 
Upvote 0
Thanks Dave. indeed helpful .I was wondering How can i Get New Row Position ie Row 18. will it be logical to use resize property to achive the same. . I want to basically repeat the ranges 3 times and show it on Firstrow 18, 32 of Each different range. Eg that range will be "A18:F23" , "A24:F31" and "A32:F37" , "A38:A45"
the following. i got error
Dim NewFirstRow as Long
NewFirstRow = rngArea.Resize(i).Value
VBA Code:
Dim lastRow As Long, rowsCnt As Long, i As Integer, FirstRowRange As Long, EndRowRange As Long, FirstNewRowRange As Long ', firstRow As Long
Dim lastNewRowRange As Long, newrowsCnt As Long, j As Integer, xFirstRow As Long
Dim firstRow as Long:  firstRow = 4
Dim NewFirstRow as Long


Dim wks As Worksheet
Set wks = Worksheets("Sheet1")

rowsCnt = wks.Range("A4:F9").Rows.Count
newrowsCnt = wks.Range("A10:F17").Rows.Count

EndRowRange = firstRow + rowsCnt - 1
FirstNewRowRange = EndRowRange + 1
lastNewRowRange = FirstNewRowRange + newrowsCnt - 1

MsgBox "Rows Count From A4:F9 = " & rowsCnt & " New Rows Range Count from A10:F17 = " & newrowsCnt & vbCrLf & _
"First Row : " & firstRow & "  Last Row " & EndRowRange & vbCrLf & _
"FirstNewRowRange : " & FirstNewRowRange & "  LastNewRowRange : " & lastNewRowRange

For i = firstRow To EndRowRange
      wks.Range("B" & i & ":F" & i).Value = "SAM"
Next i

For i = FirstNewRowRange To lastNewRowRange
      wks.Range("B" & i & ":F" & i).Value = "DSOUZA"
Next i

Set rngArea = wks.Range("B4:F9 , B10:F17")

For i = 1 To rngArea.Areas.Count
        rowsCnt = rngArea.Areas(i).Rows.Count
        FirstRow = rngArea.Areas(i).Cells(1, 1).Row
        LastRow = rngArea.Areas(i)(rngArea.Areas(i).Cells.Count).Row
       
        MsgBox "AREA " & i & Chr(10) & _
        "Rows Count From " & rngArea.Areas(i).Address(0, 0) & " = " & rowsCnt & Chr(10) & _
        "First Row : " & FirstRow & Chr(10) & _
        "Last Row " & LastRow
       
        rngArea.Offset(, 1).Areas(i).Value = Choose(i, "SAM", "DSOUZA")

        NewFirstRow = rngArea.Resize(i).Value


    Next
Thanks SamD
113
 
Upvote 0
Hi,
as I stated, to change or expand the range you need to update the addresses in Set rng line code

Rich (BB code):
Sub Workbook_Open()
    Dim wks As Worksheet
    Dim rng As Range
    Dim FirstRow As Long, LastRow As Long
    Dim rowsCnt As Long
    Dim i As Integer
  
  
    Set wks = Worksheets("Sheet1")
   
    Set rng = wks.Range("A18:F23,A24:F31,A32:F37,A38:A45")
  
  
    For i = 1 To rng.Areas.Count
        rowsCnt = rng.Areas(i).Rows.Count
        FirstRow = rng.Areas(i).Cells(1, 1).Row
        LastRow = rng.Areas(i)(rng.Areas(i).Cells.Count).Row
      
        MsgBox "AREA " & i & Chr(10) & _
        "Rows Count From " & rng.Areas(i).Address(0, 0) & " = " & rowsCnt & Chr(10) & _
        "First Row : " & FirstRow & Chr(10) & _
        "Last Row " & LastRow
      

        rng.Offset(, 1).Areas(i).Value = "Area" & i
    Next
  
End Sub

Suggestion only intended as & idea that will assist with your project

Dave
 
Last edited:
Upvote 0
Dave Yes I did understand as you mentioned for Expansion. FYI after your reply with Areas.Count concept still got better

Set rng = wks.Range("A18:F23,A24:F31,A32:F37,A38:A45")

As concept of Areas count got better
Will it be possible for RngArea with Array
Something like
Dim rngArea( ) As Range
Set rngArea(1) = wks.Range("B4:F9 , B18:F20, B29:F32") -----> this range of rows can differ with 1st range values "SAM" 6 rows, 2nd range with 3 Rows "SAM", 3rd range "DAVE" 4 rows etc... if you observe there is gap of 8 rows between Each RngArea(1)
Set rngArea(2) = wks.Range(" B10:F17") as there are 8 rows with "Dsouza". This range fixed rows will be repeated after above each range
So Target is to combine rngArea(2) after Each RngArea(1).

Result Display
BCDEF
4SAMSAMSAMSAMSAM
5SAMSAMSAMSAMSAM
6SAMSAMSAMSAMSAM
7SAMSAMSAMSAMSAM
8SAMSAMSAMSAMSAM
9SAMSAMSAMSAMSAM
10DSOUZADSOUZADSOUZADSOUZADSOUZA
11DSOUZADSOUZADSOUZADSOUZADSOUZA
12DSOUZADSOUZADSOUZADSOUZADSOUZA
13DSOUZADSOUZADSOUZADSOUZADSOUZA
14DSOUZADSOUZADSOUZADSOUZADSOUZA
15DSOUZADSOUZADSOUZADSOUZADSOUZA
16DSOUZADSOUZADSOUZADSOUZADSOUZA
17DSOUZADSOUZADSOUZADSOUZADSOUZA
18SAMSAMSAMSAMSAM
19SAMSAMSAMSAMSAM
20SAMSAMSAMSAMSAM
21DSOUZADSOUZADSOUZADSOUZADSOUZA
22DSOUZADSOUZADSOUZADSOUZADSOUZA
23DSOUZADSOUZADSOUZADSOUZADSOUZA
24DSOUZADSOUZADSOUZADSOUZADSOUZA
25DSOUZADSOUZADSOUZADSOUZADSOUZA
26DSOUZADSOUZADSOUZADSOUZADSOUZA
27DSOUZADSOUZADSOUZADSOUZADSOUZA
28DSOUZADSOUZADSOUZADSOUZADSOUZA
29DAVEDAVEDAVEDAVEDAVE
30DAVEDAVEDAVEDAVEDAVE
31DAVEDAVEDAVEDAVEDAVE
32DAVEDAVEDAVEDAVEDAVE

SamD
114
 
Upvote 0
Due to time limit
Dim rngArea( ) As Range
Set rngArea(1) = wks.Range("B4:F9 , B18:F20, B29:F32") -----> this range of rows can differ with 1st range values "SAM" 6 rows, 2nd range with 3 Rows "SAM", 3rd range
kindly ignore the above quote
Dim rngArea( ) As Range
''OLD RANGE
Set rngArea(1) = wks.Range("B4:F9 , B10:F12, B13:F16") -----> this range of rows can differ with 1st range values "SAM" 6 rows, 2nd range with 3 Rows "SAM", 3rd range
Adding RngArea(2) after Above Each rngArea(1)
The new Range becomes
wks.Range("B4:F9 , B18:F20, B29:F32")

115
 
Upvote 0
Hi,
You can if wanted, create an array of ranges

VBA Code:
Dim rngArea(1 To 3) As Range

Set rngArea(1) = wks.Range("B4:F9,B10:F12,B13:F16")
Set rngArea(2) = wks.Range("B10:F17")
Set rngArea(3) = wks.Range("B30:F32")

rngArea(1).Value = "SAM"
rngArea(2).Value = "DSOUZA"
rngArea(3).Value = "DAVE"

You would though, need to determine how best to utilise in your project

Dave
 
Upvote 0
Dave thanks for Range Array.
On Basis of below code How can i Now Re-arrange the rngArea(2) rows which are fixed and to Display the same below Each rngArea(1) in Sheet2 represented below after the code
VBA Code:
Public Sub Trial2()

Dim wks As Worksheet
Set wks = Worksheets("Sheet1")

Dim rngArea(1 To 2)  As Range
Dim totalrowsCnt As Long, NewFirstRow As Long, NewLastRow As Long
Dim FirstRow As Long, LastRow As Long, rowsCnt As Long
Dim i As Integer, j As Integer

Set rngArea(1) = wks.Range("B4:F9,B10:F12,B13:F16")
Set rngArea(2) = wks.Range("B17:F24")

        rngArea(1).Value = "SAM"
        rngArea(2).Value = "DAVE"

For j = 1 To UBound(rngArea)
  For i = 1 To rngArea(j).Areas.Count
           rowsCnt = rngArea(j).Areas(i).Rows.Count
           FirstRow = rngArea(j).Areas(i).Cells(1, 1).Row
           LastRow = rngArea(j).Areas(i)(rngArea(j).Areas(i).Cells.Count).Row
      
        MsgBox "AREA " & i & "  " & rngArea(j).Text & Chr(10) & _
        "Rows Count From " & rngArea(j).Areas(i).Address(0, 0) & " = " & rowsCnt & Chr(10) & _
        "First Row : " & FirstRow & Chr(10) & _
        "Last Row " & LastRow
             
        totalrowsCnt = totalrowsCnt + rowsCnt '+ 1
        NewFirstRow = LastRow + 1
        NewLastRow = NewFirstRow + rowsCnt - 1
    Next
   Next
      
        MsgBox "Total Rows " & totalrowsCnt & vbCrLf & NewFirstRow & " " & NewLastRow

End Sub

ABCDEF
1SAMSAMSAMSAMSAM
2SAMSAMSAMSAMSAM
3SAMSAMSAMSAMSAM
4SAMSAMSAMSAMSAM
5SAMSAMSAMSAMSAM
6SAMSAMSAMSAMSAM
7DAVEDAVEDAVEDAVEDAVE
8DAVEDAVEDAVEDAVEDAVE
9DAVEDAVEDAVEDAVEDAVE
10DAVEDAVEDAVEDAVEDAVE
11DAVEDAVEDAVEDAVEDAVE
12DAVEDAVEDAVEDAVEDAVE
13DAVEDAVEDAVEDAVEDAVE
14DAVEDAVEDAVEDAVEDAVE
15SAMSAMSAMSAMSAM
16SAMSAMSAMSAMSAM
17SAMSAMSAMSAMSAM
18DAVEDAVEDAVEDAVEDAVE
19DAVEDAVEDAVEDAVEDAVE
20DAVEDAVEDAVEDAVEDAVE
21DAVEDAVEDAVEDAVEDAVE
22DAVEDAVEDAVEDAVEDAVE
23DAVEDAVEDAVEDAVEDAVE
24DAVEDAVEDAVEDAVEDAVE
25DAVEDAVEDAVEDAVEDAVE
26SAMSAMSAMSAMSAM
27SAMSAMSAMSAMSAM
28SAMSAMSAMSAMSAM
29SAMSAMSAMSAMSAM
30DAVEDAVEDAVEDAVEDAVE
31DAVEDAVEDAVEDAVEDAVE
32DAVEDAVEDAVEDAVEDAVE
33DAVEDAVEDAVEDAVEDAVE
34DAVEDAVEDAVEDAVEDAVE
35DAVEDAVEDAVEDAVEDAVE
36DAVEDAVEDAVEDAVEDAVE
37DAVEDAVEDAVEDAVEDAVE

116
 
Last edited:
Upvote 0
Hi SamDsouza,.

With the following you display the same thing you have in your example of post #8. Try an comment

VBA Code:
Sub FillSheet()
  Dim sh As Worksheet, ary As Variant, a As Variant, nFila As Long
  Set sh = Sheets("Sheet1")
  ary = Array(6, 3, 4)
  nFila = 4
  For Each a In ary
    sh.Range("A" & nFila).Resize(a, 5).Value = "SAM"
    sh.Range("A" & nFila + a).Resize(8, 5).Value = "DAVE"
    nFila = nFila + a + 8
  Next
End Sub
 
Upvote 0
Thank you DanteAmor with a quick response indeed

Have tried your coding too. What is seen that 6, 3, 4 are displayed for SAM, and DAVE and in between 2 Blank Rows so 6 times SAM , DAVE then 3 times SAM, DAVE and 4 times SAM DAVE. this was not wanted

What i wanted was SAM to be seen with 6 Rows starting from Row 4 after this DAVE to be seen with 8 rows starting on 10th row
then SAM with 3 Rows Starting on Row 18 again and Dave with 8 Rows starting on Row 21
then SAM with 4 Rows starting on Row 29 and DAVE with 8 rows starting on Row 33 .

to get SAM in following Ranges
wks.Range("B4:F9 , B18:F20, B29:F32") "SAM"
to get DAVE in following Ranges
wks.Range("B10:F17,B21:B28,B33:38) "DAVE"
ie why i suggested Sheet2 with above representation because as per post# 8 coding from Range"B4:F16" is with SAM and from "B17: toB24" is with DAVE

so to break and represent in Sheet2 as in
With the following you display the same thing you have in your example of post #8. Try an comment
FYI it is not the same thing as in #post 8.

SamD
117
 
Upvote 0

Forum statistics

Threads
1,213,485
Messages
6,113,931
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top