VBA and macros to copy values and insert into column (left to right)

L

Legacy 485190

Guest
Hi all,

I am having difficulties to use vba and macros, to copy values (rows of data) and paste as value into a column after it. I tried using Record macros but failed to get the result as the column that I need to select and copy from always changes.

This is the origin report :
Test Cycle 1
1Test 1Pass
2Test 2Pass
3Test 3Pass
4Test 4Pass
5Test 5Pass

Test Cycle 2
1Test 1Fail
2Test 2Pass
3Test 3Pass
4Test 4Pass
5Test 5Pass


Test Cycle 3
1Test 1Fail
2Test 2Pass
3Test 3Pass
4Test 4Pass
5Test 5Pass


I need the result like this :
Test Cycle 1Test Cycle 2Test Cycle 3Test Cycle 4
1Test 1PassFailPassPass
2Test 2PassPassFailPass
3Test 3PassPassPassPass
4Test 4PassPassPassPass
5Test 5PassPassPassPass

Can anyone help me ? I need to automate this process.

Thanks in advance.
 
Sort by date Sort by votes
I'm not sure you have merge cell or not but try this. You should use XL2BB, the icon on the right most to copy and paste your sheet so that others do not have to retype to test
VBA Code: 
Sub Test()

Dim nRow As Long, nCol As Long
Dim rngRowFound As Range, rngResult As Range
Dim cell As Range, rngData As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

Set rngData = ws1.Range("B2", ws1.Cells(Rows.Count, "B").End(xlUp))

For Each cell In rngData
    Select Case cell
        Case ""
        If cell.Offset(0, -1) Like "Test Cycle*" Then
            nCol = CLng(Trim(Split(cell.Offset(0, -1), "Test Cycle")(1))) + cell.Column + 1
            ws2.Cells(1, nCol) = cell.Offset(0, -1)
        End If
    Case Else
        Set rngResult = ws2.Range("B2", ws2.Cells(Rows.Count, "B").End(xlUp))
        If rngResult.row = 1 Then Set rngResult = ws2.Range("B2")
        Set rngRowFound = rngResult.Find(cell.Value, LookAt:=xlWhole)
        If rngRowFound Is Nothing Then
            nRow = ws2.Cells(Rows.Count, "B").End(xlUp).Offset(1).row
            With ws2.Cells(nRow, nCol - 2)
                .Offset(0, -1) = cell.Offset(0, -1)
                .Value = cell
                .Offset(0, 1) = cell.Offset(0, 1)
                .Offset(0, 2) = cell.Offset(0, 2)
            End With
        Else
            With ws2.Cells(rngRowFound.row, nCol)
                .Value = cell.Offset(0, 2)
            End With
        End If
    End Select
Next

End Sub
 
Upvote 0

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Zot said:
I'm not sure you have merge cell or not but try this. You should use XL2BB, the icon on the right most to copy and paste your sheet so that others do not have to retype to test
VBA Code: 
Sub Test()

Dim nRow As Long, nCol As Long
Dim rngRowFound As Range, rngResult As Range
Dim cell As Range, rngData As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

Set rngData = ws1.Range("B2", ws1.Cells(Rows.Count, "B").End(xlUp))

For Each cell In rngData
    Select Case cell
        Case ""
        If cell.Offset(0, -1) Like "Test Cycle*" Then
            nCol = CLng(Trim(Split(cell.Offset(0, -1), "Test Cycle")(1))) + cell.Column + 1
            ws2.Cells(1, nCol) = cell.Offset(0, -1)
        End If
    Case Else
        Set rngResult = ws2.Range("B2", ws2.Cells(Rows.Count, "B").End(xlUp))
        If rngResult.row = 1 Then Set rngResult = ws2.Range("B2")
        Set rngRowFound = rngResult.Find(cell.Value, LookAt:=xlWhole)
        If rngRowFound Is Nothing Then
            nRow = ws2.Cells(Rows.Count, "B").End(xlUp).Offset(1).row
            With ws2.Cells(nRow, nCol - 2)
                .Offset(0, -1) = cell.Offset(0, -1)
                .Value = cell
                .Offset(0, 1) = cell.Offset(0, 1)
                .Offset(0, 2) = cell.Offset(0, 2)
            End With
        Else
            With ws2.Cells(rngRowFound.row, nCol)
                .Value = cell.Offset(0, 2)
            End With
        End If
    End Select
Next

End Sub
Click to expand...
I didnt merge cell, it shows error here, and the nCol is 0
1635756169810.png
 
Upvote 0
My Sheet 1
Bookcol.xlsm
ABCDE
1 Test Case Results
2Test Cycle 1
31Initialization
41.1BITSInterfacepass
51.2StationVTpass
62PDT
72.1CTP3 1Defaultpass
82.2CTP3 2Sessionpass
92.3CTP3 3Extended Sessionpass
102.4CTP3 4CMpass
112.5CTP3 5CD_hardware 1pass
12
13Test Cycle 2
141Initialization
151.1BITSInterfacepass
161.2StationVTpass
172PDT
182.1CTP3 1Defaultpass
192.2CTP3 2Sessionpass
202.3CTP3 3Extended Sessionfail
212.4CTP3 4CMpass
222.5CTP3 5CD_hardware 1pass
23
24Test Cycle 3
251Initialization
261.1BITSInterfacepass
271.2StationVTfail
282PDT
292.1CTP3 1Defaultpass
302.2CTP3 2Sessionpass
312.3CTP3 3Extended Sessionpass
322.4CTP3 4CMfail
332.5CTP3 5CD_hardware 1pass
Sheet1


My Result
Bookcol.xlsm
ABCDEFG
1Test Cycle 1Test Cycle 2Test Cycle 3
21.1BITSInterfacepasspasspass
31.2StationVTpasspassfail
42.1CTP3 1Defaultpasspasspass
52.2CTP3 2Sessionpasspasspass
62.3CTP3 3Extended Sessionpassfailpass
72.4CTP3 4CMpasspassfail
82.5CTP3 5CD_hardware 1passpasspass
9
Sheet2


Any difference in Sheet1? I modified result just to check
 
Upvote 0
Zot said:
My Sheet 1
Bookcol.xlsm
ABCDE
1 Test Case Results
2Test Cycle 1
31Initialization
41.1BITSInterfacepass
51.2StationVTpass
62PDT
72.1CTP3 1Defaultpass
82.2CTP3 2Sessionpass
92.3CTP3 3Extended Sessionpass
102.4CTP3 4CMpass
112.5CTP3 5CD_hardware 1pass
12
13Test Cycle 2
141Initialization
151.1BITSInterfacepass
161.2StationVTpass
172PDT
182.1CTP3 1Defaultpass
192.2CTP3 2Sessionpass
202.3CTP3 3Extended Sessionfail
212.4CTP3 4CMpass
222.5CTP3 5CD_hardware 1pass
23
24Test Cycle 3
251Initialization
261.1BITSInterfacepass
271.2StationVTfail
282PDT
292.1CTP3 1Defaultpass
302.2CTP3 2Sessionpass
312.3CTP3 3Extended Sessionpass
322.4CTP3 4CMfail
332.5CTP3 5CD_hardware 1pass
Sheet1


My Result
Bookcol.xlsm
ABCDEFG
1Test Cycle 1Test Cycle 2Test Cycle 3
21.1BITSInterfacepasspasspass
31.2StationVTpasspassfail
42.1CTP3 1Defaultpasspasspass
52.2CTP3 2Sessionpasspasspass
62.3CTP3 3Extended Sessionpassfailpass
72.4CTP3 4CMpasspassfail
82.5CTP3 5CD_hardware 1passpasspass
9
Sheet2


Any difference in Sheet1? I modified result just to check
Click to expand...
I get the result thank you so muchhh!
 
Upvote 0
Zot said:
My Sheet 1
Bookcol.xlsm
ABCDE
1 Test Case Results
2Test Cycle 1
31Initialization
41.1BITSInterfacepass
51.2StationVTpass
62PDT
72.1CTP3 1Defaultpass
82.2CTP3 2Sessionpass
92.3CTP3 3Extended Sessionpass
102.4CTP3 4CMpass
112.5CTP3 5CD_hardware 1pass
12
13Test Cycle 2
141Initialization
151.1BITSInterfacepass
161.2StationVTpass
172PDT
182.1CTP3 1Defaultpass
192.2CTP3 2Sessionpass
202.3CTP3 3Extended Sessionfail
212.4CTP3 4CMpass
222.5CTP3 5CD_hardware 1pass
23
24Test Cycle 3
251Initialization
261.1BITSInterfacepass
271.2StationVTfail
282PDT
292.1CTP3 1Defaultpass
302.2CTP3 2Sessionpass
312.3CTP3 3Extended Sessionpass
322.4CTP3 4CMfail
332.5CTP3 5CD_hardware 1pass
Sheet1


My Result
Bookcol.xlsm
ABCDEFG
1Test Cycle 1Test Cycle 2Test Cycle 3
21.1BITSInterfacepasspasspass
31.2StationVTpasspassfail
42.1CTP3 1Defaultpasspasspass
52.2CTP3 2Sessionpasspasspass
62.3CTP3 3Extended Sessionpassfailpass
72.4CTP3 4CMpasspassfail
82.5CTP3 5CD_hardware 1passpasspass
9
Sheet2


Any difference in Sheet1? I modified result just to check
Click to expand...
Sorry for disturbing again, the result shows that 1 and 2 is missing, and it start from 1.1 and so on, any method to solve it?
 
Upvote 0
Try this modified code
VBA Code: 
Sub Test()

Dim nRow As Long, nCol As Long
Dim rngRowFound As Range, rngResult As Range
Dim cell As Range, rngData As Range
Dim GotInit As Boolean, GotPDT As Boolean
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

Set rngData = ws1.Range("B2", ws1.Cells(Rows.Count, "B").End(xlUp))

For Each cell In rngData
    Select Case cell
        Case ""
            Select Case True
                Case cell.Offset(0, -1) Like "Test Cycle*"
                    nCol = CLng(Trim(Split(cell.Offset(0, -1), "Test Cycle")(1))) + cell.Column + 1
                    ws2.Cells(1, nCol) = cell.Offset(0, -1)
                Case cell.Offset(0, 1) = "Initialization", cell.Offset(0, 1) = "PDT"
                    If Not GotInit Or Not GotPDT Then
                        nRow = ws2.Cells(Rows.Count, "C").End(xlUp).Offset(1).row
                        ws2.Cells(nRow, cell.Column).Offset(0, -1) = cell.Offset(0, -1)
                        ws2.Cells(nRow, cell.Column).Offset(0, 1) = cell.Offset(0, 1)
                    End If
                    If cell.Offset(0, 1) = "Initialization" Then GotInit = True
                    If cell.Offset(0, 1) = "PDT" Then GotPDT = True
            End Select
        Case Else
            Set rngResult = ws2.Range("B2", ws2.Cells(Rows.Count, "B").End(xlUp))
            If rngResult.row = 1 Then Set rngResult = ws2.Range("B2")
            Set rngRowFound = rngResult.Find(cell.Value, LookAt:=xlWhole)
            If rngRowFound Is Nothing Then
                nRow = ws2.Cells(Rows.Count, "C").End(xlUp).Offset(1).row
                With ws2.Cells(nRow, nCol - 2)
                    .Offset(0, -1) = cell.Offset(0, -1)
                    .Value = cell
                    .Offset(0, 1) = cell.Offset(0, 1)
                    .Offset(0, 2) = cell.Offset(0, 2)
                End With
            Else
                With ws2.Cells(rngRowFound.row, nCol)
                    .Value = cell.Offset(0, 2)
                End With
            End If
    End Select
Next

End Sub
 
Upvote 0
Zot said:
Try this modified code
VBA Code: 
Sub Test()

Dim nRow As Long, nCol As Long
Dim rngRowFound As Range, rngResult As Range
Dim cell As Range, rngData As Range
Dim GotInit As Boolean, GotPDT As Boolean
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)

Set rngData = ws1.Range("B2", ws1.Cells(Rows.Count, "B").End(xlUp))

For Each cell In rngData
    Select Case cell
        Case ""
            Select Case True
                Case cell.Offset(0, -1) Like "Test Cycle*"
                    nCol = CLng(Trim(Split(cell.Offset(0, -1), "Test Cycle")(1))) + cell.Column + 1
                    ws2.Cells(1, nCol) = cell.Offset(0, -1)
                Case cell.Offset(0, 1) = "Initialization", cell.Offset(0, 1) = "PDT"
                    If Not GotInit Or Not GotPDT Then
                        nRow = ws2.Cells(Rows.Count, "C").End(xlUp).Offset(1).row
                        ws2.Cells(nRow, cell.Column).Offset(0, -1) = cell.Offset(0, -1)
                        ws2.Cells(nRow, cell.Column).Offset(0, 1) = cell.Offset(0, 1)
                    End If
                    If cell.Offset(0, 1) = "Initialization" Then GotInit = True
                    If cell.Offset(0, 1) = "PDT" Then GotPDT = True
            End Select
        Case Else
            Set rngResult = ws2.Range("B2", ws2.Cells(Rows.Count, "B").End(xlUp))
            If rngResult.row = 1 Then Set rngResult = ws2.Range("B2")
            Set rngRowFound = rngResult.Find(cell.Value, LookAt:=xlWhole)
            If rngRowFound Is Nothing Then
                nRow = ws2.Cells(Rows.Count, "C").End(xlUp).Offset(1).row
                With ws2.Cells(nRow, nCol - 2)
                    .Offset(0, -1) = cell.Offset(0, -1)
                    .Value = cell
                    .Offset(0, 1) = cell.Offset(0, 1)
                    .Offset(0, 2) = cell.Offset(0, 2)
                End With
            Else
                With ws2.Cells(rngRowFound.row, nCol)
                    .Value = cell.Offset(0, 2)
                End With
            End If
    End Select
Next

End Sub
Click to expand...
No, it can't work because there have many column like this
1635940572687.png
 
Upvote 0
Looks like your data keep changing every time
Before that the numbering is just repeating
1
1.1
1.2
.
.
2
2.1
.
1636071424102.png

Now your numbering is
1
1,1
.
.
2
2.1
.
.
3
and so on
1636071445520.png

meaning the item are different already. How to put them together in rows? Further more, you never tell how you want to handle pending and not executed. Looks like they have no meaning since no numbering for test or action.
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
When Checkbox clicked > Send mail
Replies
3
Views
141
ING Hammer
I
L
  • Solved
Excel formule question, lookup and count
Replies
3
Views
185
Joe4
Joe4
O
  • Question
IF Function? Multiple Columns of Data but requires one overall output
Replies
2
Views
191
Ozzy23
O
I
  • Question
How to chart when the test fail in number of test.
Replies
0
Views
158
i200yrs
I
markhasnomana
  • Solved
Calculate the number of survey to pass the target
Replies
8
Views
310
awoohaw
awoohaw

Forum statistics

Threads
1,215,032
Messages
6,122,772
Members
449,095
Latest member
m_smith_solihull

Share this page

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