Copy cell content with an if condition + small loop (VBA Excel)

Joe BR

New Member
Joined
Dec 29, 2023
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hello everyone,

I really thought I could do it but after a morning having fun I decided to ask for help.

I have a data tab with some characteristics in the range B32:C43 (on the B column is the characteristic and on C is a "yes or no"). I want to copy the cell B content when the cell C value is "yes" to the sheet 5 starting from B17 onwards.

There is a catch, on row 40 there is a number (that goes from 1 to infinite). In the middle of the copy, I want to create as many lines as specified in C40 and fill them with "Trial X" (where X is the number).

It's something like this

Column A
Column B
Column C
Row 32Moisture ExpositionY
Row 33BiologicalN
Row 34ScreeningY
Row 35Gama XN
Row 36Gama YN
Row 37Gama ZN
Row 38Gama TN
Row 39Alfa 32Y
Row 40Number of trials5
Row 41OvercountY
Row 42Final testingN

And this should generate in the sheet 5 something like this:
Column AColumn B
Row 17Moisture Exposition
Row 18Screening
Row 19Alfa 32
Row 20Trial 1
Row 21Trial 2
Row 22Trial 3
Row 23Trial 4
Row 24Trial 5
Row 25Overcount

Can somebody help me?
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Change the sheet name (in red) to suit your needs.
Rich (BB code):
Sub CopyCell()
    Application.ScreenUpdating = False
    Dim v As Variant, arr() As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, cnt As Long, x As Long: x = 1
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets(5)
    v = srcWS.Range("B32", srcWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = LBound(v) To UBound(v)
        If v(i, 2) = "Y" Then
            ReDim Preserve arr(x)
            arr(x) = v(i, 1)
            x = x + 1
        ElseIf IsNumeric(v(i, 2)) Then
            For cnt = 1 To v(i, 2)
                ReDim Preserve arr(x)
                arr(x) = "Trial " & cnt
                x = x + 1
            Next cnt
        End If
    Next i
    desWS.Range("B17").Resize(x).Value = Application.Transpose(arr)
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks @mumps ! Although one thing needs fixing, the macro is looking throughout the full column (until the end) and it should look only up to row 42 (there are other numbers not to be considered after that row). I tried to adjust directly on the line below replacing "B42" instead of "rows.count" but then it skipped the first lines.
v = srcWS.Range("B32", srcWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value

Can you please help me again?

Thanks!
 
Upvote 0
Try:
VBA Code:
v = srcWS.Range("B32:B42").Resize(, 2).Value
 
Upvote 0
Try:
VBA Code:
v = srcWS.Range("B32:B42").Resize(, 2).Value
Yes sir! Thanks!

Final adjustment, it is copying the first "yes" on row 18 instead of 17 (which is not a problem, I even prefer like this now) but it is deleting the value that was on row 17 (on the destination). Any idea why?
 
Upvote 0
This line of code starts pasting at row 17:
VBA Code:
desWS.Range("B17").Resize(x).Value = Application.Transpose(arr)
I'm not sure why it is copying the first "yes" on row 18.
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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