If cell = multiple ranges then copy

[crazyeyeschase]

I have a workbook where I am trying to pull info from multiple sheets to one if a cell in a column from one sheet is = to a cell in a different sheet

So if a cell in column F of sheet1,sheet2,sheet3 = a cell in column G of sheet4

Then copy the info from cell row A,B,C, and D from sheet1,2, or 3 to sheet 4 cell A,B,D, and F

I'm not sure if there is an easy formula for this or if a macro might be best.

My thought for the macro would be to run one sheet at a time with something like below

For each cell in sheet1 column F to last row
if cell is equal to range sheet4 column G to last row then
copy range sheet 1 AB and paste to range sheet 4 AB
copy range sheet 1 CD and paste to range sheet 4 DF
next cell

Amy thought or suggestions?

I'm willing to research just need guidance on the best route.

 

[DanteAmor]

Hi @crazyeyeschase. I hope you are well.

Try the following macro:

Sub MultipleRanges()
  Dim sh4 As Worksheet
  Dim dic As Object
  Dim a As Variant, d As Variant, arrSh As Variant, aSh As Variant
  Dim i As Long, nRow As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set sh4 = Sheets("Sheet4")
  arrSh = Array("Sheet1", "Sheet2", "Sheet3")
  
  d = sh4.Range("A1", sh4.Range("G" & Rows.Count).End(3)).Value2
  For i = 1 To UBound(d)
    dic(d(i, 7)) = i                'index for column G
  Next
    
  For Each aSh In arrSh
    a = Sheets(aSh).Range("A1", Sheets(aSh).Range("F" & Rows.Count).End(3)).Value2
    For i = 1 To UBound(a)
      If dic.exists(a(i, 6)) Then   'compare column F with column G
        nRow = dic(a(i, 6))
        d(nRow, 1) = a(i, 1)        'copy A to A
        d(nRow, 2) = a(i, 2)        'copy B to B
        d(nRow, 4) = a(i, 3)        'copy C to D
        d(nRow, 6) = a(i, 4)        'copy D to F
      End If
    Next i
  Next aSh
  
  sh4.Range("A1").Resize(UBound(d, 1), UBound(d, 2)).Value = d
End Sub

A couple of things to consider:

1. I hope that on sheet 4 you do not have formulas in the cells of columns A to G. If so, I need to make some changes to the macro.
2. If a value in column G of sheet 4 exists in several sheets, it will only put one result, the value of the last sheet, for example, if in column G of sheet 4 you have the data "orange ", and in sheet1 you have "orange" and also in sheet2 you have "orange", then the macro will put the data from sheet2.

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[crazyeyeschase]

Hi @crazyeyeschase. I hope you are well.

Try the following macro:

Sub MultipleRanges()
  Dim sh4 As Worksheet
  Dim dic As Object
  Dim a As Variant, d As Variant, arrSh As Variant, aSh As Variant
  Dim i As Long, nRow As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  Set sh4 = Sheets("Sheet4")
  arrSh = Array("Sheet1", "Sheet2", "Sheet3")
 
  d = sh4.Range("A1", sh4.Range("G" & Rows.Count).End(3)).Value2
  For i = 1 To UBound(d)
    dic(d(i, 7)) = i                'index for column G
  Next
  
  For Each aSh In arrSh
    a = Sheets(aSh).Range("A1", Sheets(aSh).Range("F" & Rows.Count).End(3)).Value2
    For i = 1 To UBound(a)
      If dic.exists(a(i, 6)) Then   'compare column F with column G
        nRow = dic(a(i, 6))
        d(nRow, 1) = a(i, 1)        'copy A to A
        d(nRow, 2) = a(i, 2)        'copy B to B
        d(nRow, 4) = a(i, 3)        'copy C to D
        d(nRow, 6) = a(i, 4)        'copy D to F
      End If
    Next i
  Next aSh
 
  sh4.Range("A1").Resize(UBound(d, 1), UBound(d, 2)).Value = d
End Sub

A couple of things to consider:

1. I hope that on sheet 4 you do not have formulas in the cells of columns A to G. If so, I need to make some changes to the macro.
2. If a value in column G of sheet 4 exists in several sheets, it will only put one result, the value of the last sheet, for example, if in column G of sheet 4 you have the data "orange ", and in sheet1 you have "orange" and also in sheet2 you have "orange", then the macro will put the data from sheet2.

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

Wow I wasn't expecting a full macro thanks so much.

The sheet doesn't have any formulas as its an assigned parking list for a building I manage/ recently took over

Sheet 1 I manage directly, sheets 2 and 3 pull data from a separate workbook which I share with my tenant contact for those companies.

When I either need to assign new parking or when I need to bill the tenants for their parking I can pull the data from the shared workbooks then update

Is there a way that column C on sheet 4 can either pull the sheet name from where G matched or I can make a hidden column with the name and it can copy past that over.

Personally I tried that latter (placed the company name in column "O" and hid it.

When I add this code

        d(nRow, 3) = a(i, 15)        'copy D to F

I get a subscript out of line error on that line.

 

[DanteAmor]

Is there a way that column C on sheet 4 can either pull the sheet name from where G matched or I can make a hidden column with the name and it can copy past that over.

Personally I tried that latter (placed the company name in column "O" and hid it.

When I add this code

d(nRow, 3) = a(i, 15) 'copy D to F
I get a subscript out of line error on that line.

Try this:

Sub MultipleRanges()
  Dim sh4 As Worksheet
  Dim dic As Object
  Dim a As Variant, d As Variant, arrSh As Variant, aSh As Variant
  Dim i As Long, nRow As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set sh4 = Sheets("Sheet4")
  arrSh = Array("Sheet1", "Sheet2", "Sheet3")
  
  d = sh4.Range("A1", sh4.Range("G" & Rows.Count).End(3)).Value2
  For i = 1 To UBound(d)
    dic(d(i, 7)) = i                'index for column G
  Next
    
  For Each aSh In arrSh
    a = Sheets(aSh).Range("A1", Sheets(aSh).Range("F" & Rows.Count).End(3)).Value2
    For i = 1 To UBound(a)
      If dic.exists(a(i, 6)) Then   'compare column F with column G
        nRow = dic(a(i, 6))
        d(nRow, 1) = a(i, 1)        'copy A to A
        d(nRow, 2) = a(i, 2)        'copy B to B
        d(nRow, 3) = aSh            'sheet name
        d(nRow, 4) = a(i, 3)        'copy C to D
        d(nRow, 6) = a(i, 4)        'copy D to F
      End If
    Next i
  Next aSh
  
  sh4.Range("A1").Resize(UBound(d, 1), UBound(d, 2)).Value = d
End Sub

 

[crazyeyeschase]

Try this:

Sub MultipleRanges()
  Dim sh4 As Worksheet
  Dim dic As Object
  Dim a As Variant, d As Variant, arrSh As Variant, aSh As Variant
  Dim i As Long, nRow As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  Set sh4 = Sheets("Sheet4")
  arrSh = Array("Sheet1", "Sheet2", "Sheet3")
 
  d = sh4.Range("A1", sh4.Range("G" & Rows.Count).End(3)).Value2
  For i = 1 To UBound(d)
    dic(d(i, 7)) = i                'index for column G
  Next
   
  For Each aSh In arrSh
    a = Sheets(aSh).Range("A1", Sheets(aSh).Range("F" & Rows.Count).End(3)).Value2
    For i = 1 To UBound(a)
      If dic.exists(a(i, 6)) Then   'compare column F with column G
        nRow = dic(a(i, 6))
        d(nRow, 1) = a(i, 1)        'copy A to A
        d(nRow, 2) = a(i, 2)        'copy B to B
        d(nRow, 3) = aSh            'sheet name
        d(nRow, 4) = a(i, 3)        'copy C to D
        d(nRow, 6) = a(i, 4)        'copy D to F
      End If
    Next i
  Next aSh
 
  sh4.Range("A1").Resize(UBound(d, 1), UBound(d, 2)).Value = d
End Sub

Golden thanks so much