VBA Query help copy paste

[sowmyag]

I am trying to copy the rows in a different sheet on the following conditions

IF Col4 = "B1 or B2" then copy all the rows which has the same value in Col1 = 123

The new worksheet should copy only first three rows.

I tried writing a query and i am able to copy only B1 and B2 but not the row which has C value in Col2 which has the same value 123 in Col1, please note i don't want to copy the last row which also has "C" value

Can someone please help ?

Col1	Col2	Col3	Col4
123​	xxx	yyy	B1
123​	xxx	yyy	C
123​	xxx	yyy	B2
145​	xxx	yyy	B3
145​	xxx	yyy	C

Please see my copy paste query below -

Sub Inscopemacro()
Application.ScreenUpdating = False
Dim sh1 As Worksheet, sh2 As Worksheet, b As Long, LastR1 As Long, LastR2 As Long
Dim rngCopy As Range, rng As Range, cel As Range
Dim strSearch1 As String, strSearch2 As String
Sheets("Inscope").Cells.Clear

strSearch1 = "B1"
strSearch2 = "B2"
Set sh1 = ActiveSheet 'Extract from Dremio worksheet
Set sh2 = ThisWorkbook.Sheets("Inscope")
LastR1 = sh1.Range("AR" & Rows.Count).End(xlUp).Row
LastR2 = sh2.Range("A" & Rows.Count).End(xlUp).Row + 1

Set rng = sh1.Range("AR2:AR" & LastR1)
For Each cel In rng.Cells
If cel.Value = strSearch1 Or cel.Value = strSearch2 Then
If rngCopy Is Nothing Then
Set rngCopy = sh1.Rows(cel.Row)
Else
Set rngCopy = Union(rngCopy, sh1.Rows(cel.Row))
End If
End If
Next
If Not rngCopy Is Nothing Then
rngCopy.Copy Destination:=sh2.Cells(LastR2, 1)
End If
Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

In your description you have columns 1, 2, 3 and 4.
But in your macro you have column AR, so I don't know what your column 1 is.
Adjust the columns in the macro, I put some notes so you can identify where you should make changes.

Sub Inscopemacro()
  Dim sh1 As Worksheet
  Dim a As Variant
  Dim dic As Object
  Dim rng As Range
  Dim i As Long, lr As Long
 
  Set sh1 = Sheets("Dremio")      'source sheet
  Set dic = CreateObject("Scripting.Dictionary")
  lr = sh1.Range("AR" & Rows.Count).End(3).Row
  Set rng = sh1.Range("A" & lr + 1)
  a = sh1.Range("A1:AR" & lr).Value
 
  For i = 2 To UBound(a, 1)
    Select Case a(i, 44)          '44 is AR column
      Case "B1", "B2"
        dic(a(i, 1)) = Empty      'Change the 1 to the column number
    End Select
  Next
 
  For i = 1 To UBound(a, 1)
    If dic.exists(a(i, 1)) Then   'Change the 1 to the column number
      Set rng = Union(rng, sh1.Range("A" & i))
    End If
  Next
 
  With Sheets("Inscope")          'destination sheet
    .Cells.ClearContents
    rng.EntireRow.Copy .Range("A2")
  End With
End Sub

 

[sowmyag]

Col1 is 37 . Thanks for the query but its copying all the rows.

As per the table -

I want only first three rows which has B1 and B2 in col 4 and copy all the records of Col1 (including Col4 C) but the query is copying first three rows and also the last row but i dont want the last row.

The group of Col1 rows should be copied only if the value in Col4 has B1 and B2

Hope i am making sense.

Col1	Col2	Col3	Col4
123	xxx	yyy	B1
123	xxx	yyy	C
123	xxx	yyy	B2
145	xxx	yyy	B3
145	xxx	yyy	C

 

[DanteAmor]

IF Col4 = "B1 or B2" then copy all the rows which has the same value in Col1 = 123

The group of Col1 rows should be copied only if the value in Col4 has B1 and B2

I am a little confused.
It is difficult to understand your need with just one example.
The macro must be prepared for all possible scenarios, or try to cover all of them.

So, in the following sample, which groups should be copied, and if you could put a brief description of why it should be copied.
For example:
Group 123, YES must copy because ...
Group 456, should NOT be copied because ...
Group 888, ... etc.

Dante Amor
	A	B	C	D
1	COL1	COL2	COL3	COL4
2	123	b2	c2	d2
3	123	b3	c3	B1
4	123	b4	c4	d4
5	123	b5	c5	B2
6	456	b6	c6	d6
7	456	b7	c7	d7
8	456	b8	c8	d8
9	888	b9	c9	B1
10	888	b10	c10	d10
11	888	b11	c11	d11
12	999	b12	c12	B2
13	999	b13	c13	d13
14	999	b14	c14	d14
15	123	b15	c15	d15
16	222	b16	c16	B2
17	222	b17	c17	B1
18	222	b18	c18	D18
19	654	b19	c19	D19
20	654	b20	c20	D20
Dremio

 

[sowmyag]

See below - I have updated your example.
For example:
Group 123, YES must copy because it has Col 4 B1 or B2
Group 456, should NOT be copied because Col4 has no value B1 or B2
Group 888, . should be copied because it has B1 value in Col 4
Group 999, . should be copied because it has B2 value in Col 4
Group 222, . should be copied because it has B2 or B1 value in Col 4
Group 222, . should NOT be copied because it has no B2 or B1 value in Col 4

Dremio
	A	B	C	D
Dante Amor
1	COL1	COL2	COL3	COL4
2	123	b2	c2	d2
3	123	b3	c3	B1
4	123	b4	c4	d4
5	123	b5	c5	B2
6	456	b6	c6	d6
7	456	b7	c7	d7
8	456	b8	c8	d8
9	888	b9	c9	B1
10	888	b10	c10	d10
11	888	b11	c11	d11
12	999	b12	c12	B2
13	999	b13	c13	d13
14	999	b14	c14	d14
15	123	b15	c15	d15
16	222	b16	c16	B2
17	222	b17	c17	B1
18	222	b18	c18	D18
19	654	b19	c19	D19
20	654	b20	c20	D20

 

[sowmyag]

See below - I have updated your example.
For example:
Group 123, YES must copy because it has Col 4 B1 or B2
Group 456, should NOT be copied because Col4 has no value B1 or B2
Group 888, . should be copied because it has B1 value in Col 4
Group 999, . should be copied because it has B2 value in Col 4
Group 222, . should be copied because it has B2 or B1 value in Col 4
Group 654, . should NOT be copied because it has no B2 or B1 value in Col 4

Dante Amor
	A	B	C	D
Dremio
1	COL1	COL2	COL3	COL4
2	123	b2	c2	d2
3	123	b3	c3	B1
4	123	b4	c4	d4
5	123	b5	c5	B2
6	456	b6	c6	d6
7	456	b7	c7	d7
8	456	b8	c8	d8
9	888	b9	c9	B1
10	888	b10	c10	d10
11	888	b11	c11	d11
12	999	b12	c12	B2
13	999	b13	c13	d13
14	999	b14	c14	d14
15	123	b15	c15	d15
16	222	b16	c16	B2
17	222	b17	c17	B1
18	222	b18	c18	D18
19	654	b19	c19	D19
20	654	b20	c20	D20

 

[DanteAmor]

Try this:

Sub Inscopemacro()
  Dim sh1 As Worksheet
  Dim a As Variant
  Dim dic As Object
  Dim rng As Range
  Dim i As Long
  
  Set sh1 = Sheets("Dremio")      'source sheet
  Set dic = CreateObject("Scripting.Dictionary")
  a = sh1.Range("A1", sh1.Range("AR" & Rows.Count).End(3)).Value
  
  For i = 2 To UBound(a, 1)
    If a(i, 44) = "B1" Or a(i, 44) = "B2" Then dic(a(i, 37)) = Empty
  Next
  
  For i = 1 To UBound(a, 1)
    If dic.exists(a(i, 37)) Then
      If rng Is Nothing Then Set rng = sh1.Range("A" & i) Else Set rng = Union(rng, sh1.Range("A" & i))
    End If
  Next
  
  With Sheets("Inscope")          'destination sheet
    .Cells.ClearContents
    rng.EntireRow.Copy .Range("A2")
  End With
End Sub

 

[sowmyag]

Thanks worked. I added code for excluding group if the cells in col1 is empty.

Really appreciate your help.

 

[DanteAmor]

Im glad to help you, thanks for the feed back.