CODEWITHSUNDEEP
vbaexceldynamicrange
ubuntuuber
ubuntuuber

Reputation: 732

How to loop a dynamic range and copy select information within that range to another sheet

I have already created a VBA script that is about 160 lines long, which produces the report that you see below.

Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.

Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...

Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.

Thank you in advance, J

Example

Upvotes: 1

Views: 1092

Answers (1)

WGS
WGS

Reputation: 14179

As discussed, here's my approach. All the details are in the code's comments so make sure you read them.

Sub GetUserNameTotals()

    Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
    Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
    Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
    Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
    Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
    Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row

    'Turn off AutoFilter to avoid errors.
    ShTarget.AutoFilterMode = False

    'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
    'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
    With RngTarget
        .AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
        Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
        Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
    End With

    'Logic: For each cell in the first column of stats, let's get its offset one cell above
    'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
    'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
    'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
    'copy first before the stats.
    For Each CellRef In ColRef
        If RngNames Is Nothing Then
            Set RngNames = CellRef.Offset(-1, -7)
        Else
            Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
        End If
    Next CellRef

    'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
    'to you. Of course, modify as necessary.
    RngNames.Copy ShPaste.Range("A1")
    RngTargetVisible.Copy ShPaste.Range("B1")

End Sub

Screenshots:

Set-up:

enter image description here

Result:

enter image description here

Demo video here:

Using Filters and Visible Cells

Let us know if this helps.

Upvotes: 1

Related Questions