VBA LOOPS Question

Question

hi,  i hope this question is not too tricky.  am not good at vba, so if can get a working example.  i took some time to review this before posting,  here goes. 

(this is everything would need,  but the work needed is just for a small loops section, in the first part of the main macro below,  and might not be that much work to fix.  not sure if set up correctly for a loop.)

Basic Description:

I have a macro below, that works as is except for looping down to bottom of sheet.  each click does one cycle.  example 2 (at bottom) is of a loop that works for another item (unrelated to this purpose), but was trying to make it work.

I am trying do a loop repeat on (what have that works; if have a better way of doing same fine, but:  will need to maintain use of file 2 as an option if new / other unquote "LOOP METHODS" do not work later.

what my macro does (successfully, just not repeating / looping),  is for each click of command button:

screenupdating = OFF

 - 1:  (start cell / in start column already selected at top of sheet from a previous step),  offset 180 rows is selected & COPY.

 - 2:  file 2 is selected, paste values,  another sub macro manipulates data,  output is selected & COPY.

 - 3:  file 1 is selected, and paste values is performed in / to a new column (in same row started working from),  screen if scrolled down & the cell from the 1st column is reselected for a starting point.

 - 4:  DONE.  i hit the command button again & the above repeats moving 180 rows at a time, down the sheet.  would like help looping that, to the last row.

(note:  understand that the last row / section will be less than 180 rows..  part of my macro that already works.  will hope to see last rows processed as the previous.  IE:  DO NOT CARE that the blank output - back to file 1 is empty anyways & does not matter if overextend target by a portion of 180 rows).

EXAMPLE 1:    (example 2 at bottome is merely a loop that got example from,  that works), this is a 'WORKING' example with lines blanked out / as is,  just needs to be looped). thanks.

Private Sub CommandButton1_Click()

    Dim C2 As String    'dynamic reference to work cells that have cell or column references eg:

    C2 = Range("C2")    'C2:  =SUBSTITUTE(SUBSTITUTE(CELL("address",$EL$4),"$",""),"","")

    Dim C3 As String    'C3:  =SUBSTITUTE(SUBSTITUTE(CELL("address",$BG$315),"$",""),"","")

    C3 = Range("C3")    'eg col ref below

    If Range(C2).Value = "Z" Then       'step 2

    'gotop                              '(steps 1 already performed)

    'Range(C3).Offset(1, 0).Select      '(steps 1 start cell already selected)

    If 0 = 1 Then   'simple bypass sheet to module temporary work, change to:  0 = 0  to work on loop items above:  ELSE

'LOOP ATTEMPT:  FIX THIS ?

    r = ActiveCell.Row     'do i need to define 180 rows? ERROR: 'r' variable not defined

    c = ActiveCell.Column  'do i need to define 2 columns?

    Lastrow = Range("C7").Value        'C7 has:  =ROW(A$1500)

    For Each c In Range(Cells(r, c), Cells(Lastrow, c))

    Call DL1        'DL1 is 100% same as below copy (between XXX rows below)

    Next c

    ''gotop

    ''Application.Run "'file1.xls'!top" 'cursor to top row in book1

    ''Range(C2).Select

    ''Selection.ClearContents

    Else    'END OF LOOP attempt,  is in regard to below, if correct in trying to place copy of below, in a sub()

'' XXXXXXXXXX  same as copy in submodule attempt for loop

''Sub DL1()    'unblocked lines below work 'as is' / located here - in main sheet

    ''Dim C4 As String

    ''C4 = Range("C4")

    ''Dim C5 As String

    ''C5 = Range("C5")

    Application.ScreenUpdating = False  'UPDATE OFF

    Application.Calculation = xlManual

    Cells(ActiveCell.Row, C4).Select    'C4  START file 1, source col  C4 START

    Range(ActiveCell, ActiveCell.Offset(180, 0)).Copy   'OFFSET 180 COPY

    Windows("file2.xls").Activate      'file 2  paste

    Application.Run "file2.xls'!GOHOME"      'CURSOR RESET FOR NEXT ROUND (/button click if separate clicks)

    ActiveSheet.PasteSpecial Format:=3, link:=1, DisplayAsIcon:=False, IconFileName:=False

    Application.Run "file2.xls'!DOWORK"  'my macro: works

    Windows("file1.xls").Activate     'file 1  paste

    Cells(ActiveCell.Row, C5).Select    'destination col, dl copy fm book2

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    ActiveWindow.SmallScroll Down:=180  'ROWS    ROWS    ROWS    ROWS

    ActiveCell.Offset(180, 0).Select

    Cells(ActiveCell.Row, C4).Select    'C4  FINISH back to original col 180 lines down

''End Sub

'' XXXXXXXXXX

    End If

    End If

''C4 C5 have dynamic references to columns, eg:

''=SUBSTITUTE(SUBSTITUTE(CELL("address",$BG4),"$",""),ROW(),"")&":"&SUBSTITUTE(SUBSTITUTE(CELL("address",$BG4),"$",""),ROW(),"")

XXXXXXXXXXXXXXXXXXXX    XXXXXXXXXXXXXXXXXXXX    XXXXXXXXXXXXXXXXXXXX   

XXXXXXXXXXXXXXXXXXXX    XXXXXXXXXXXXXXXXXXXX    XXXXXXXXXXXXXXXXXXXX   

EXAMPLE 2:   where got loop from  (PASTE FORMULAS DOWN A COLUMN,  manually perform copy & manually place cursor)

 - pasting formulas, formats, or all done very fast, automatically from where place cursor,  down to last row skipping rows for col A has:  "."

Sub PastecellE()        'alte  (paste cell pastecell EQ/ Formula down a col)

If 0 = 0 Then

    Dim C6 As String

    C6 = Range("C6")

    'If Target.Row < C6 Then Exit Sub    'error: object required; safety cancel vb

r = ActiveCell.Row      'altF  (paste cell Format to col), 2nd 'selection' below

c = ActiveCell.Column   'altP  (paste cells All to col), next 'selection'

Lastrow = Range("C7").Value

    Application.ScreenUpdating = False      'ANSWER:  UPDATE OFF

    For Each c In Range(Cells(r, c), Cells(Lastrow, c))

    If Cells(c.Row, "A").Value <> "." Then

    c.Select

    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    End If

    Next c

    'doBeeps (1), (2)    'secs beeps

'put these keyboard shortcuts in: 'ThisWorkbook', allows for items to still work if toolbar shortcuts get corrupt.

    'Application.OnKey "%{e}", "pastecelle"  'special paste functions, of selected cells (Equations, Formats, Paste-all)

    'Application.OnKey "%{f}", "pastecellf"  'safety feature:  must hit copy 1st & have cursor where want to paste from

    'Application.OnKey "%{p}", "pastecellp"  'cntrl alt f12: "^%{F12}", numbers: remove brackets, place in 'ThisWorkbook'

'End Sub

Answer 1

Thank you !!  for the reply,  been toying with this for awhile.  not sure how long will take me to reivew this (up nights sometimes.. slow at vb).

3:25 & just up :)   but would reply ahead on couple things just in case critical.

(not sure if precise the query)

 - 180 rows at a time:  yes  (is method in use att),  that is roughly all file1 can process aat.

if accurate:

loop stuff    '(180 line blocks occur in DL1, ok for last loop partial / past last line;  no more "loops" past last line;  180 lines past last line is ok for output done).

call DL1    'KEY:  we won't mess too much with DL1.  already works after much effort. (this "Z" click is 1 of a series of operations already complete)

end loop stuff

 - guessing what need is less work than what supplied.  (i should have had a skeleton to show a short word problem as above..  idea had been submitted)  thanks.

XXXXXXXXXX    XXXXXXXXXX

(note below:  my macro works copying - always values - back and forth, you may have got it, but just need help with loop).

 - should of said line on number of columns start stops  (file 1 start: 1 col of names/ alpha col BG:  copy values to file2 col A    (data processed output:  cols C thru L),  file 2 cols values copy pasted back to file 1  (selecting col:  FF).

 - not sure about blank rows in regard to your vb.  they exist in my file1  (col A has a period in each row cell, that is already disregarded in file 2 processing / view in file 2 is "white on white" / not seen.  if relevant:  copy paste values covers that.

 - not sure what would ask first on how to apply.  i think the key is (if my setup correct / don't see your cross reference idea to..)  from my code & key line:

Call DL1    'which if forgive is in the same macro above, just insert into a sub all lines (activate / remove hypens in front of),  starting at: 

Sub DL1()    'in same for please forgive:  macro above works is proof of concept for use a Sub for DL1,  by use of simple on - off line:  If 0 = 1,  all of above macro works "as is".  (hope that is clear to follow),  located near top of macro.  since set at If 0 = 1,  the normal command click operation works for lines blanked out  OR  my LOOP work is bypassed.

XXXXXXXXXX

with that said, i am guessing your write of 180 line material is neccesary for your macro to work (even though otherwise coverd in my macro - might need some of your methods to work make this work?).

what do not see,  is where (if any) call to a DL1 would occur to make a loop occur.

really beg pardon if i might need to ask for answers in part / portions.

not complaining:  already have columns copy - paste covered.  (have funny use of fixed cells with reference to columns formula's, that dynamically update when i very occasionally cut paste delete columns).    - point is  (trying to mesh what your programming needs with mine..) 

points ??:  (since don't know vb well..)  let me guesse: 

 - need your vb to loop,  my macro already does every thing for move 180,  mine does select columns required & does all copy paste required.  if correct in saying:

i just need loop to do a call on given work,  with regard to blocks of 180 lines already performed,  to stop when it reaches a final line / bottom line.

i am guessing, as has been the case in other work, i need less from your macro.

note:  pasting values already copied at end of sheet (blank lines,  col BG has periods ".", no names  (disregard that, does not matter to vb).  pasting upwards of 180 lins of blank stuff  (values:  0's and n/a's,  disregard that),  past the last line is ok.

KEY:    what need attention to is  (a loop macro..) & no more 180 line loops past the Last line.

note:  will entertain better methods for later,  but need to get item working in lieu of other / similar methods already in use.  need to get work going.

work is not for a hobby.  do or die project.  thanks for the help.

if accurate:

loop stuff    '(180 line blocks occur in DL1, ok for last loop partial / past last line;  no more "loops" past last line;  180 lines past last line is ok for output done).

call DL1

end loop stuff

Answer 2

I really do not understand what you are tring to achieve with your code but am I understanding correctly that you want a loop to copy and paste 180 rows at a time? If so, the the following is a simple example to copy 180 rows at a time from a single column and paste them into another worksheet in columns side by side. It might give you a clue as to how to write such a loop.

See in the comments where it tests the last row of the range in each loop and if blank, it adjusts the size of the range to copy to only include from the first to the last used cell in the range. (Copying more than one column may need to use the worksheet function counta to test for a blank row.)

I can't help anymore without a copy of your workbook because it is too hard to understand what you are trying to achieve.

The line of code between the asterisk lines is the critical one to create a loop for every 180 rows.

Sub CopyBlocksOfCells()

    Dim i As Long

    Dim lngLastRow As Long

    Dim lngStartRow As Long

    Dim rngToCopy As Range

    Dim lngCol As Long

    'Find last used cell in column A and assign it to a variable

    With Sheets("Sheet1")

        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        'The loop code below does not have to start at 1. _

         It can start at whatever row you like and you could _

         generate the start number as per the commented out line _

        lngStartRow = 5

        'lngStartRow = ActiveCell.Row   'Alternative code to generate a start number

        lngCol = 0  'LngCol is the column number to paste into Sheet2

        '******************************************************************

        For i = lngStartRow To lngLastRow Step 180

        '******************************************************************

            Set rngToCopy = .Range(.Cells(i, "A"), .Cells(i, "A").Offset(179))

            'Test if last cell of range to copy is populated and if not, _

             re-set the range from the first cell to last populated cell. _

             This may apply to last loop if the last range does not have _

             the full 180 rows.

            With rngToCopy

                If .Cells(.Rows.Count, 1) = "" Then 'Test last cell of range to copy

                    Set rngToCopy = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))

                End If

            End With

            lngCol = lngCol + 1 'Increment the column number for the output in Sheet2

            'Following line is Copy and Paste with one line of code

            rngToCopy.Copy Destination:=Sheets("Sheet2").Cells(1, lngCol)

        Next i

    End With

End Sub