Creating Multiple rows

I would like to create multiple cells from a given data, the code should be able to read the data from a defined cell and split into multiple rows provided certain creteria is met. For instance if the workday is split between two states I would like it to show the name of each of these two states in two rows.

In this instance the client has stayed in two states as he was traveling, I would like to split this into two entries using VB. It should scan the range, identify such instances and create a separate table with multiple values.

Creating Multiple rows

Expert Asked on August 30, 2017 in VBA.
Add Comment
10 Answer(s)

Hello

Can you attach sample of your workbook with some of the expected output?

Expert Answered on August 30, 2017.

Hi Yasser,

I am unable to attach the excel, however have attached the screen shot from the same.

RE: Creating Multiple rowsInput Screen

RE: Creating Multiple rowsOutput

 

 

 

on August 31, 2017.

Hi Please let me know if you need more information on this.

on September 4, 2017.

Thanks for sharing sample input & output screen shots.

on September 6, 2017.
Add Comment

HI Pranab,

Here is the VBA macro for your requirement. I have written comments for each statement for your understand.  You can modify Input sheet name according to you.

Sub MoveData_To_Multiple_Rows()
'Variable declaration
Dim iCntr As Integer, lstRow As Integer
'Change below Input sheet name
With Sheets("Sheet2")
'Find last row
lstRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Loop through all rows
For iCntr = lstRow To 2 Step -1
'Check if data is available or not in Column 'F'
If .Range("F" & iCntr) <> "" Then
'Add new row
.Rows(iCntr + 1).Insert Shift:=xlDown
'Copy Date & Day
.Range("A" & iCntr & ":" & "B" & iCntr).Copy Destination:=.Range("A" & iCntr + 1)
'Copy Country & State
.Range("F" & iCntr & ":" & "G" & iCntr).Copy Destination:=.Range("C" & iCntr + 1)
'Update Activity as Workday
.Range("E" & iCntr + 1) = "Work Day"
'Split Count
.Range("J" & iCntr & ":" & "J" & iCntr + 1) = 0.5
'Delete data
.Range("F" & iCntr & ":" & "I" & iCntr) = ""
End If
Next
End With
End Sub

Hope it help you. Please do let me know, If you need any further modifications.

Regards!

Expert Answered on September 6, 2017.
Add Comment

Valli sir-when I run this macro nothing seems to be happening, am I missing something. I would want the macro to search for rows with Workday and wherever there are multiple states, copy them in separate rows either on Sheet 1 or Sheet 2 as separate entries.

Expert Answered on September 6, 2017.
Add Comment

It will be better to upload sample of your workbook with dummy data .. if there is sensitive data

Expert Answered on September 6, 2017.
Add Comment

Unable to attach the excel sheet, do I need to subscribe to something before I do it? I don’t mind doing that as well. Please let me know

Expert Answered on September 7, 2017.
Add Comment

You can upload your file to any of file host uploading .. Try this site

https://wetransfer.com

Upload the file then copy the link and post it here

Expert Answered on September 7, 2017.
Add Comment

Hi Yaseer here is the link https://we.tl/8R9kqh99SX

Expert Answered on September 7, 2017.
Add Comment

Hello Try this code

Sub Test()
Dim a As Variant
Dim b As Variant
Dim i As Long
Dim j As Long
Dim k As Long
With Sheets("Sheet1")
a = .Range("B3:M" & .Cells(Rows.Count, 2).End(xlUp).Row).Value
End With
ReDim b(1 To UBound(a, 1) * 2, 1 To 9)
For i = LBound(a, 1) To UBound(a, 1)
k = k + 1
For j = 1 To 8
b(k, j) = a(i, j)
Next j
If a(i, 9) = "" Then b(k, 9) = 1 Else b(k, 9) = 0.5
If b(k, 8) = "Non-Workday" Then b(k, 9) = 0
If a(i, 9) <> "" Then
k = k + 1
For j = 1 To 3
b(k, j) = a(i, j)
Next j
b(k, 4) = Trim(Split(a(i, 11), " ")(0))
b(k, 5) = a(i, 5)
b(k, 6) = a(i, 9)
b(k, 7) = a(i, 10)
b(k, 8) = a(i, 8)
If b(k, 8) = "Non-Workday" Then
b(k, 9) = 0
Else
b(k, 9) = 0.5
End If
End If
Next i
With Sheets("Sheet2")
.Cells.Clear
.Range("A1").Resize(, 9).Value = Array("Assignee ID", "Assignee Name", "Engagement", "Date", "Day", "Location Country", "Location State/Province", "Activity", "Count")
.Range("A2").Resize(k, UBound(b, 2)).Value = b
.Columns(4).NumberFormat = "[$-en-US]d-mmm-yyyy;@"
.Columns.AutoFit
End With
End Sub

 

Expert Answered on September 7, 2017.
Add Comment

You are awesome, it works perfectly. Only issue is that the Date format in the Output Sheet is coming in as “Custom” instead of “Date” because of which this needs to be modified manually.

Expert Answered on September 7, 2017.
Add Comment

You’re welcome..

You can delete this line

.Columns(4).NumberFormat = "[$-en-US]d-mmm-yyyy;@"

Then format it as you wish

or replace the previous line with the proper format

Expert Answered on September 7, 2017.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.