• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 663
  • Last Modified:

Copy/paste through variable range loop

Hi,
my macro opens and copy/paste a text file into excel.
This file represents transactions per a certain group. Actually 9 groups are present. On variable ranges, "Grand Totals" per group are present. Group names are 22-1, 22-2, 22-A etc. Now, what my macro does is using the Find method (dim myval / myval = "grand") and copy / paste the found area to another sheet. So far, so good.
However, what I've done to stop the loop is to define in the 'Do until..' statement that I tell the macro to fill in range("Z1") = 1 when the "Grand total" is found of group "22-9". I rather want this to be more flexible because it may happen that from tomorrow onwards the last group will not be "22-9" but maybe "22-10" or "22-X" or whatever.
Next to this, if found a grand-total group, it will copy / paste this to another sheet but rather than going to the "select sheet2, paste values, select sheet1 and move on" procedure I would like to use the copy destination:= statement but then I will have a conflict when the macro will copy paste for the first time (since the first time there is no defined destination cell in sheet2).
Attached the file with what I made of it.
Does anyone has a better idea?
Thanks in advance for your help.

P.S. since I'm a newbie here, it would be fair that - should you think that points to be gained - you advise me if the reward correspond with your findings.

Test.xls
0
RepTeam
Asked:
RepTeam
  • 2
  • 2
1 Solution
 
GrahamSkanCommented:
You could try this:
Sub test()
    Dim myval1, myval2
    Dim LastGroup As String
    Dim r As Integer
    r = Sheets("ND22").UsedRange.Rows.Count
    Do Until Sheets("ND22").Cells(r, 1).Value = "ND"
        r = r - 1
    Loop
    LastGroup = Sheets("ND22").Cells(r, 2).Value
    myval1 = "grand"
 
    Do Until Sheets("ND22 sum").Range("Z1") = 1
        Sheets("ND22").Select
        Range("A1").Select
        Cells.Find(What:=myval1, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
            myval2 = ActiveCell.Offset(-4, -3)
        ActiveCell.Offset(1, -3).Select
        Range(ActiveCell, ActiveCell.End(xlDown).End(xlDown).End(xlDown).End(xlToRight)).Select
        Selection.Copy
        Sheets("ND22 sum").Select
        ActiveSheet.Paste
        ActiveCell = myval2
        ActiveCell.Font.Bold = True
        ActiveCell.Font.ColorIndex = 5
        ActiveCell.End(xlDown).Offset(5, 0).Select
        If myval2 = LastGroup Then
            Range("Z1") = 1
        End If
    Loop
 
 
End Sub

Open in new window

0
 
RepTeamAuthor Commented:
Thanks for your option. Especially the first part, finding last group, is as simple as it is effective. Overlooked this method completely, thank you.
However, I also want to get rid of the "selection.copy / sheets.... select / pastespecial etc stuff.
Any idea if this can be written more effectively like a copy destination value ?
0
 
GrahamSkanCommented:
I'm not too sure what you are looking for. You could get rid of most of the selection and use ranges instead. That could save some 'flickering' and a few lines of code.

Copy and paste are convenient because the whole of the cells' properties are copied, including formulae and formatting, and not just the data. However, there are other ways.
0
 
RepTeamAuthor Commented:
Thanks for your info and at least the first part of your solution.
With regards to the second part (copy destination other sheet), I found a similar solution, see code.
I think this does the trick and therefore accept your solution.
Thanks.
    Dim LastGroup As String
    Dim r, r1, r2
    r = Sheets("ND22").UsedRange.Rows.Count
    Do Until Left((Sheets("ND22").Cells(r, 1).Value), 2) = "ND"
        r = r - 1
    Loop
    LastGroup = Sheets("ND22").Cells(r, 1).Value
    myval1 = "grand"
    Do Until Sheets("ND22 sum").Range("Z1") = 1
    Sheets("ND22").Select
    Cells.Find(What:=myval1, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        myval2 = ActiveCell.Offset(-4, -3)
    ActiveCell.Offset(1, -3).Select
''on the same sheet I already prepare now the lay out to be copied ''
    ActiveCell = myval2
    ActiveCell.Font.Bold = True
    ActiveCell.Font.ColorIndex = 5
'' with this 'r1' I set the last line thus preparing new spot for paste ''
    r1 = Sheets("ND22 sum").UsedRange.Rows.Count
    Range(ActiveCell, ActiveCell.End(xlToRight).End(xlDown)).Copy Destination:=Sheets("ND22 sum").Cells(r1, 1).Offset(2, 0)
    If myval2 = LastGroup Then
    Sheets("ND22 sum").Range("Z1") = 1
    End If
    Loop

Open in new window

0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now