Option Explicit
Sub BiodataWritting_27_ColmIn_3Rows()
' Active sheet is "cc"
'there should not be Extra Numbering in Colm A
Dim LinerArr() As Variant 'don't declare elements (or array size)
Dim SplitedArray() As Variant
Dim hrbb, NoR, Norow, Ocolm, TotalElements, NeededRow, x, y, z, _
i, c, r, NewR, NewC, NeededColm, turn, hrcc As Integer
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Active sheet should be 'cc'" & vbCr & _
"There should not be Extra Numbering in Colm A in Sheet 'bb'" & vbCr & _
"because it will decide No of Students" & vbCr & _
"Change value of Norow or No of Rows in the Programme" & vbCr & _
"If U don't want to continue 'Press Cancel'"
' Define message.
Style = vbOKCancel + vbCritical ' Define buttons.
Title = "Check The Followings" ' Define title.
Response = MsgBox(Msg, Style, Title)
If Response = vbCancel Then ' User chose Yes.
Exit Sub
End If
hrbb = 2 'count of header row when array reads sht"bb" cells
With Worksheets("bb")
'below is Number of Students in Sheet 'bb'
'NoR = Number of Records
'so there should not be Extra Numbering in Colm A
NoR = .Range("A65536").End(xlUp).Row - hrbb
End With
hrbb = 2 'count of header row when array reads sht"bb" cells
hrcc = 3 'count of header row in sht"cc" cells
'NoR = 136 'Count of Students or Records ( here 116 students)
Ocolm = 27 'count of colms in Basic table.
TotalElements = NoR * Ocolm
Norow = 3 ' Count of Rows that will need for each Record
'when writting in sheet"cc".
NeededRow = NoR * Norow 'there are 27 element in one row or Record
'so it will need 3 rows for each record.whn wrting at sht.
'136*3 = 408 row for all records working at "step 3".
NeededColm = Ocolm / Norow ' Count of Colm that will need
'for each Record when writting in sheet"cc".
ReDim Preserve SplitedArray(1 To NeededRow, 1 To NeededColm)
ReDim Preserve LinerArr(TotalElements)
'Below: When Hindi "sh" or "'"(as in Shubhi Sharma) is written
'to Array it Trims "sh". The Following condition prevents it.
'Array also changes Date Format when reading at one shot.
'but not when it is read element by elememt instead
'of reading at one shot.like-> array = range (A1:AA138)
'1.Now read the records element by element to make a liner Array
With Worksheets("bb")
i = 0 'this will hold elements of Array
For r = 1 To NoR 'Total Records,136 here
For c = 1 To Ocolm 'Records are in 27 colms.whn arry reads.
i = i + 1 'arry elemtn 1st
If .Cells(r + hrbb, c).Font.Name = "Kruti Dev 010" _
And Left(.Cells(r + hrbb, c), 1) = "'" Then
LinerArr(i) = "'" & .Cells(r + hrbb, c)
Else: LinerArr(i) = .Cells(r + hrbb, c): End If
Next c
Next r
End With
x = LinerArr(53) 'Test
y = LBound(LinerArr) 'Test
z = UBound(LinerArr) 'Test
'Cells(3, 7) = x 'A Test
'2.Now split the Array in NeededRow and NeededColm
i = 1
For turn = 1 To NeededRow Step 3
For NewC = 1 To NeededColm
For NewR = turn To turn + 2
SplitedArray(NewR, NewC) = _
LinerArr(i): i = i + 1
Next NewR
Next NewC
Next turn
'3.Now Write the splited Records in Sheet cc
Worksheets("cc").Range(Cells(4, 1), Cells(NeededRow + hrcc, NeededColm)).Value = SplitedArray
End Sub
Sub BiodataWritting_33_ColmIn_3Rows()
'Active sheet should be "cc"
'there should not be Extra Numbering in Colm A
'***** this shows that this may be changed according to needs.
Dim LinerArr() As Variant 'don't declare elements (or array size)
Dim SplitedArray() As Variant
Dim hrbb, NoR, Norow, Ocolm, TotalElements, NeededRow, NeededColm, x, y, z, _
i, c, r, NewR, NewC, turn, hrcc As Integer
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Active sheet should be 'cc'" & vbCr & _
"There should not be Extra Numbering in Colm A in Sheet 'bb'" & vbCr & _
"because it will decide No of Students" & vbCr & _
"Change value of Norow or No of Rows in the Programme" & vbCr & _
"If U don't want to continue 'Press Cancel'"
' Define message.
Style = vbOKCancel + vbCritical ' Define buttons.
Title = "Check The Followings" ' Define title.
Response = MsgBox(Msg, Style, Title)
If Response = vbCancel Then ' User chose Yes.
Exit Sub
End If
hrbb = 2 'count of header row when array reads sht"bb" cells
hrcc = 3 'count of header row in sht"cc" cells
With Worksheets("bb")
'below is Number of Students in Sheet 'bb'
'NoR = Number of Records( here 116 students)
NoR = .Range("A65536").End(xlUp).Row - hrbb
End With
'hrbb = 2 'count of header row when array reads sht"bb" cells
'NoR = 136 'Count of Students or Records
Ocolm = 33 'count of colms in Basic table.*****
Norow = 3 ' Count of Rows that will need for each Record*****
'when writting in sheet"cc".
TotalElements = NoR * Ocolm
NeededRow = NoR * Norow 'there are 33 element in one row or Record
'so it will need 3 rows for each record.whn wrting at sht.
'136*3 = 408 row for all records working at "step 3".
NeededColm = Ocolm / Norow ' Count of Colm that will need
'for each Record when writting in sheet"cc".
ReDim Preserve SplitedArray(1 To NeededRow, 1 To NeededColm)
ReDim Preserve LinerArr(TotalElements)
'Below: When Hindi "sh" or "'"(as in Shubhi Sharma) is written
'to Array it Trims "sh". The Following condition prevents it.
'Array also changes Date Format when reading at one shot.
'but not when it is read element by elememt instead
'of reading at one shot.like-> array = range (A1:AA138)
'1.Now read the records element by element to make a liner Array
With Worksheets("bb")
i = 0 'this will hold elements of Array
For r = 1 To NoR 'Total Records,136 here
For c = 1 To Ocolm 'Records are in 33 colms.whn arry reads.
i = i + 1 'arry elemtn 1st
If .Cells(r + hrbb, c).Font.Name = "Kruti Dev 010" _
And Left(.Cells(r + hrbb, c), 1) = "'" Then
LinerArr(i) = "'" & .Cells(r + hrbb, c)
Else: LinerArr(i) = .Cells(r + hrbb, c): End If
Next c
Next r
End With
'x = LinerArr(28) 'Test
': y = LBound(LinerArr):z = UBound(LinerArr):'Cells(3, 7) = x 'A Test
'2.Now split the Array in NeededRow and NeededColm
i = 1
For turn = 1 To NeededRow Step 3
For NewC = 1 To NeededColm
For NewR = turn To turn + 2
SplitedArray(NewR, NewC) = _
LinerArr(i): i = i + 1
Next NewR
Next NewC
Next turn
'3.Now Write the splited Records in Sheet cc
Worksheets("cc").Range(Cells(4, 1), Cells(NeededRow + hrcc, NeededColm)).Value = SplitedArray
End Sub
Sub BiodataWritting_36_ColmIn_3Rows()
'Active sheet should be "cc"
'there should not be Extra Numbering in Colm A
'***** this shows that this may be changed according to needs.
Dim LinerArr() As Variant 'don't declare elements (or array size)
Dim SplitedArray() As Variant
Dim hrbb, NoR, Norow, Ocolm, TotalElements, NeededRow, NeededColm, x, y, z, _
i, c, r, NewR, NewC, turn, hrcc As Integer
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Active sheet should be 'cc'" & vbCr & _
"There should not be Extra Numbering in Colm A in Sheet 'bb'" & vbCr & _
"because it will decide No of Students" & vbCr & _
"Change value of Norow or No of Rows if it is not 3rows" & vbCr & _
"If U don't want to continue 'Press Cancel'"
' Define message.
Style = vbOKCancel + vbCritical ' Define buttons.
Title = "Check The Followings" ' Define title.
Response = MsgBox(Msg, Style, Title)
If Response = vbCancel Then ' User chose Yes.
Exit Sub
End If
hrbb = 2 'count of header row when array reads sht"bb" cells
hrcc = 3 'count of header row in sht"cc" cells
With Worksheets("bb")
'below is Number of Students in Sheet 'bb'
'NoR = Number of Records ( here 116 students)
NoR = .Range("A65536").End(xlUp).Row - hrbb
'NoR = Last used row in bb (118) - count of header row in bb (2) =116 students
End With
'hrbb = 2 'count of header row when array reads sht"bb" cells
'NoR = 136 'Count of Students or Records
Ocolm = 36 'count of colms in Basic table.(bb) *****
Norow = 3 ' Count of Rows that will need for each Record in cc *****
'when writting in sheet"cc".
TotalElements = NoR * Ocolm
NeededRow = NoR * Norow 'there are 33 element in one row or Record
'so it will need 3 rows for each record.whn wrting at sht.
'136*3 = 408 row for all records working at "step 3".
NeededColm = Ocolm / Norow ' Count of Colm that will need
'for each Record when writting in sheet"cc".
ReDim Preserve SplitedArray(1 To NeededRow, 1 To NeededColm)
ReDim Preserve LinerArr(TotalElements)
'Below: When Hindi "sh" or "'"(as in Shubhi Sharma) is written
'to Array it Trims "sh". The Following condition prevents it.
'Array also changes Date Format when reading at one shot.
'but not when it is read element by elememt instead
'of reading at one shot.like-> array = range (A1:AA138)
'1.Now read the records element by element to make a liner Array
With Worksheets("bb")
i = 0 'this will hold elements of Array
For r = 1 To NoR 'Total Records,136 here
For c = 1 To Ocolm 'Records are in 33 colms.whn arry reads.
i = i + 1 'arry elemtn 1st
If .Cells(r + hrbb, c).Font.Name = "Kruti Dev 010" _
And Left(.Cells(r + hrbb, c), 1) = "'" Then
LinerArr(i) = "'" & .Cells(r + hrbb, c)
Else: LinerArr(i) = .Cells(r + hrbb, c): End If
Next c
Next r
End With
'x = LinerArr(28) 'Test
': y = LBound(LinerArr):z = UBound(LinerArr):'Cells(3, 7) = x 'A Test
'2.Now split the Array in NeededRow and NeededColm
i = 1
For turn = 1 To NeededRow Step 3
For NewC = 1 To NeededColm
For NewR = turn To turn + 2
SplitedArray(NewR, NewC) = _
LinerArr(i): i = i + 1
Next NewR
Next NewC
Next turn
'Now Write the splited Records in Sheet cc
Worksheets("cc").Range(Cells(4, 1), Cells(NeededRow + hrcc, NeededColm)).Value = SplitedArray
End Sub
