Loop through Range (row) based on Column

rilzniak

Active Member
Joined
Jul 20, 2012
Messages
280
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.

SportMajorMinor1Minor2Minor3Minor4
HockeyNHLAHLKHLECHLCHL
FootballNFLXFLCFL
BaseballMLBMiLB
SoccerMLS

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!
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Try this. Data in sheet "Sh1", results in sheet "Sh2"

VBA Code:
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
 
Upvote 0
Solution
Try this. Data in sheet "Sh1", results in sheet "Sh2"

VBA Code:
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:

Rich (BB code):
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?
 
Upvote 0
Did you test the macro with the sample data that you put in post #1?
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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
ABCDEFGHIJ
1Year1Year2Year3Year4SportMajorMinor1Minor2Minor3Minor4
2HockeyNHLAHLKHLECHLCHL
3FootballNFLXFLCFL
4BaseballMLBMiLB
5SoccerMLS
Inputs


Book1
ABC
20TeamPlayerNumber
21
NHL


Book1
ABC
20TeamPlayerNumber
21MBMPerfetti17
22MBMMaier41
AHL

Here is the manual code I was using:
Rich (BB code):
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.
 
Upvote 0
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.
 
Upvote 0
Then change "A" by "E":

Rich (BB code):
  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
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,287
Members
448,562
Latest member
Flashbond

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