Loop through Range (row) based on Column

[rilzniak]

Hey, I've seen a few things similar on here but haven't been able to find exactly what I'm looking to do and am unable to piece together the code so I'm hoping someone here has a suggestion. I'm looking to perform an action on a table within the document based on its name within a cell.

Sport	Major	Minor1	Minor2	Minor3	Minor4
Hockey	NHL	AHL	KHL	ECHL	CHL
Football	NFL	XFL	CFL
Baseball	MLB	MiLB
Soccer	MLS

If a league has the word "ball" in column A and its 'Major' league has a 'Minor' league, I want to copy the data from its table to another table (I have this last part figured out). What is the best way to loop through the data? The columns and rows will continue to expand with additional data so I'll need to make sure my range references the last used rows and columns, which I can do; and believe I know how to skip blanks, it's just this nested loop (I think) that's causing me grief.

Any help is appreciated. Thanks!

 

[DanteAmor]

Try this. Data in sheet "Sh1", results in sheet "Sh2"

Sub CopyData()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lc As Long
  Dim minor As Boolean
  
  With Sheets("Sh1")
    lr = .Range("A" & Rows.Count).End(3).Row
    lc = .Cells(1, Columns.Count).End(1).Column
    a = .Range("A1", .Cells(lr, lc)).Value
  End With
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  
  For i = 2 To UBound(a, 1)
    If InStr(1, a(i, 1), "ball", vbTextCompare) > 0 And a(i, 2) <> "" Then
      minor = False
      For j = 3 To UBound(a, 2)
        If a(i, j) <> "" Then
          minor = True
          Exit For
        End If
      Next
      If minor = True Then
        k = k + 1
        For j = 1 To UBound(a, 2)
          b(k, j) = a(i, j)
        Next
      End If
    End If
  Next i
  
  Sheets("Sh2").Range("A2").Resize(k, UBound(b, 2)).Value = b
End Sub

 

[rilzniak]

Try this. Data in sheet "Sh1", results in sheet "Sh2"

Sub CopyData()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lc As Long
  Dim minor As Boolean
 
  With Sheets("Sh1")
    lr = .Range("A" & Rows.Count).End(3).Row
    lc = .Cells(1, Columns.Count).End(1).Column
    a = .Range("A1", .Cells(lr, lc)).Value
  End With
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
 
  For i = 2 To UBound(a, 1)
    If InStr(1, a(i, 1), "ball", vbTextCompare) > 0 And a(i, 2) <> "" Then
      minor = False
      For j = 3 To UBound(a, 2)
        If a(i, j) <> "" Then
          minor = True
          Exit For
        End If
      Next
      If minor = True Then
        k = k + 1
        For j = 1 To UBound(a, 2)
          b(k, j) = a(i, j)
        Next
      End If
    End If
  Next i
 
  Sheets("Sh2").Range("A2").Resize(k, UBound(b, 2)).Value = b
End Sub

Hi Dante, thank you for your reply, that's some impressive code! I thought I was going to be able to understand the result, but I'm having difficulty. Perhaps you can help me? Here is the code I was initially using to copy from one table to another:

Set copysht = Worksheets("ahl")
Set pastesht = Worksheets("nhl")
Set cTable = copysht.ListObjects(1).DataBodyRange
Set pTable = pastesht.ListObjects(1).DataBodyRange

lastrow = pastesht.ListObjects(1).ListColumns(1).Range.Rows.Count
cTable.Copy pTable.Offset(lastrow - 2, 0)

I had to make a few changes so now the 'Sport' column is in 'E' but the result remains the same: my goal is to loop through the AHL, KHL, etc. ("minor") tables and paste the data into the NHL ("major") table. I could just hard-code in each copy/paste instance but this list may grow in length and width over time so it would mean manual updating, which is not going to be possible long term. Do you have any suggestions on how I can alter what you've written to accommodate?

 

[DanteAmor]

Did you test the macro with the sample data that you put in post #1?

 

[rilzniak]

Did you test the macro with the sample data that you put in post #1?

I did, yes. The code copies the row of data and places it on Sht2. In addition, it also gives me an error row - 21 (that one's weird).

I guess I should also mention that it doesn't loop through the data as I had hoped - it only copies one row, when there should be multiple.

 

[DanteAmor]

You can put the example with which you are testing the macro. Use XL2BB tool.
You tell me in which lines you have problems and what result you want.

 

[rilzniak]

As an example, there are three worksheets - Inputs, NHL, AHL. I'm trying to copy the data in the AHL table (named AHL, on the AHL named worksheet) to the NHL table (named NHL, on the NHL named worksheet) based on the entries in the table below.

Book1
	A	B	C	D	E	F	G	H	I	J
1	Year1	Year2	Year3	Year4	Sport	Major	Minor1	Minor2	Minor3	Minor4
2					Hockey	NHL	AHL	KHL	ECHL	CHL
3					Football	NFL	XFL	CFL
4					Baseball	MLB	MiLB
5					Soccer	MLS
Inputs

Book1
	A	B	C
20	Team	Player	Number
21
NHL

Book1
	A	B	C
20	Team	Player	Number
21	MBM	Perfetti	17
22	MBM	Maier	41
AHL

Here is the manual code I was using:

Set copysht = Worksheets("ahl")
Set pastesht = Worksheets("nhl")
Set cTable = copysht.ListObjects(1).DataBodyRange
Set pTable = pastesht.ListObjects(1).DataBodyRange

lastrow = pastesht.ListObjects(1).ListColumns(1).Range.Rows.Count
cTable.Copy pTable.Offset(lastrow - 2, 0)

In order to avoid manually setting the 'copysht' and 'pastesht' variables within the code before performing the action below it, I was hoping to find a way to loop through the rows and columns - both increasing range sizes over time - based on what words are contained within the 'Sport' column - in our example I used the word "ball" but this may change to "hockey" or something else, which I'd prefer to change manually.

 

[DanteAmor]

If a league has the word "ball" in column A

I am not understanding. You tested my macro with other data that you didn't specify in your post #1. Of course it won't work.

Now, your macro doesn't work, but right now I don't understand what your requirement is or how your data is in the "Input" sheet or what results you want. If you are going to use "ball" or "hockey" you must continue with that example and put the results of that example.
In the AHL sheet you have data, I don't know if it is input or output data, but if it is output data, where did the data come from: "MBM", "Perfetti", "17", "MBM", "Maier", "41" I asked you to put the desired result but I have no idea where you get that data.

I propose the following. I help you with a new macro that does what you want, but you have to start over.
With examples that exist and clear results.

 

[rilzniak]

I am not understanding.

Sorry, I'm not doing a good job of explaining. I can play around with the code you provided and I'll stumble on a solution eventually.

Thank you for your help!

 

[DanteAmor]

Then change "A" by "E":

  With Sheets("Sh1")
    lr = .Range("E" & Rows.Count).End(3).Row
    lc = .Cells(1, Columns.Count).End(1).Column
    a = .Range("E1", .Cells(lr, lc)).Value
  End With