Create a looping macro that stops at pre determined row?

Hi!


I am in need of some help figuring out how to loop this process. The macro is built to fetch poker hand histories and paste them one at a time to let my formulas extract the info I want. Which then is stored on a different sheet. The formulas are working from a specified range of cells that each individual hand has to be pasted to.

In short the code below does exactly that, it selects the next hand data, copies it and then deletes the data to bring up next hand from under it.

So the trick now is that I want to loop this process so I dont have to click a button for each hand since there can be upwards to 10k hands to processs. I figured I could have a predetermined range where I can paste hands, so as to not run to many at a single go.


I have looked at the do until function but I dont really understand how to apply it to my case?

Sub HandProcess()

    rows("12").Select
    Selection.Delete Shift:=xlUp
    
    Range("A10").Select
    Range(Selection, Selection.End(xlDown)).Select
   
   ''''''''''''''''''''''''''''
   ' this part needs to be filled out with more code to
   ' copy the right cell values to another sheet but that
   ' part I can manage
   
   Selection.Copy
    Range("R1").Select
    ActiveSheet.Paste
''''''''''''''''''''''''''''''''''

      Range("A10").Select
    Range(Selection, Selection.End(xlDown)).Select
       Selection.Delete Shift:=xlUp
  rows("10:12").Select
    Selection.Delete Shift:=xlUp

End Sub

Thanks for the reply but that wont work as cells will be empty sometimes as the eport file adds a couple of emty rows to each hand.


So I got the looping part to work ok but when I run it in the main sheet it freezes up. It seems to slow down dramatically once the text is copied into working formulas. In my test sheet I ran the loop of moving up hands over a good 300+ hands and it worked flawlessly.

In the main sheet it cant process two hands with the loop but without the loop and me clicking a macro button it works. So my guess is that the amount of formulas are to blame? Even when I copy in a sample manually it definietly slows down Excel notieably for a second before all the formulas updates.




This is more or less the entire code I want to run. The part inside the '''''' lines is code for storing the values that are extracted from the hands. I uploaded the sheet with the code without the storing part. (I havent tried the code with this part when I go through it manually)



The workbook is kind of big and I could separate it if that might help?


Or if any one have a good idea how I can incorporate what the formulas are doing into a complete macro?

 Sub HandProcess888()

  Application.ScreenUpdating = False
    
    Do Until ThisWorkbook.Sheets("Sheet1").Cells(90, 1).Value = "Stop"
    
    rows("92").Select
    Selection.Delete Shift:=xlUp
    
    Range("A90").Select
    Range(Selection, Selection.End(xlDown)).Select
   

   Selection.Copy
    Range("A32").Select
    ActiveSheet.Paste
''''''''''''''''''''''''''''''
Dim rows As Range
Dim cols As Range
Set rows = Sheets("NashChartView").Range("T1")
Set cols = Sheets("NashChartView").Range("U1")


Range("U3").Select
ActiveCell.Offset(rows, cols).Range("A1").Copy
 Range("AI17").Select
 ActiveSheet.Paste
 
  Range("AI18").Copy
  Range("U3").Select
  ActiveCell.Offset(rows, cols).Range("A1").Select
   ActiveSheet.Paste
   
       With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10498160
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
  
  
  
   Range("AI17").Copy
Range("U3").Select
ActiveCell.Offset(rows, cols).Range("A1").Select
 ActiveSheet.Paste

'''''''''''''''''''''''''''''''''''
    Range("A32:A81").Select
    Range("A81").Activate
    Selection.ClearContents


      Range("A90").Select
    Range(Selection, Selection.End(xlDown)).Select
       Selection.Delete Shift:=xlUp
  rows("90:92").Select
    Selection.Delete Shift:=xlUp

Loop
Application.ScreenUpdating = True
  End Sub

So I actually got everything to work now!! I had forgotten to replace "Sheet1" with my sheet name....a good thing I dont need to be good at this to put food on the table.

I tried a run with 20 hands and it took pretty dead on 1min, so in one hour it would complete 1200 hands. This would be kind of a PITA and I am looking for ways to speed everything up a bit?


One thing that seems to add alot of steps is my custom function for extracting dollar sums. If I manually go through the code it has to run that function multiple times (guessing for each cell that is applicable).

   Sub HandProcess888()

Application.ScreenUpdating = False

  '''''''''''''''''''''''''



   Do Until ThisWorkbook.Sheets("888Hands").Cells(90, 1).Value = "Stop"
    
    Sheets("888Hands").Select
    Range("A90").Select
    Range(Selection, Selection.End(xlDown)).Select
   
   ''''''''''''''''''''''''''''
   Selection.Copy
    Range("A32").Select
    ActiveSheet.Paste
    
 '''''''''''''''''''''''''''''start of storing

Dim rowR As Range
Dim colR As Range
Set rowR = Sheets("888Hands").Range("O6")
Set colR = Sheets("888Hands").Range("O7")

Sheets("HandCombosStatsMyown").Select
Range("B6").Select

'Count, Raised/bet, called, collected

ActiveCell.Offset(rowR, colR).Range("A1") = Sheets("888Hands").Range("J17")
ActiveCell.Offset(rowR, colR).Range("B1") = Sheets("888Hands").Range("J15")
ActiveCell.Offset(rowR, colR).Range("C1") = Sheets("888Hands").Range("J14")
ActiveCell.Offset(rowR, colR).Range("D1") = Sheets("888Hands").Range("J16")


ActiveCell.Offset(rowR, colR).Range("A1").Select

    ActiveCell.Offset(-2, 0).Range("A1:D1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Range("A1:D1").Select

    Selection.ClearContents

        Sheets("888Hands").Select
  Range("A32:A81").ClearContents
 '''''''''''''''''''''''''''''''''

      Range("A90").Select
    Range(Selection, Selection.End(xlDown)).Select
       Selection.Delete Shift:=xlUp
  rows("90").Delete Shift:=xlUp
  
Loop
Application.ScreenUpdating = True
  End Sub