CODEWITHSUNDEEP
vbaexcel
K.Reed
K.Reed

Reputation: 25

Is it possible to loop through the Data Worksheet?

I was wondering if there was a way to loop through my Data worksheet, rather than coding it out from A2 to AQ2?

Worksheets("FORM TEMPLATE").Range("D9").Copy
Worksheets("Data").Range("A2").PasteSpecial xlPasteValues

Worksheets("FORM TEMPLATE").Range("D10").Copy
Worksheets("Data").Range("B2").PasteSpecial xlPasteValues

Worksheets("FORM TEMPLATE").Range("J9").Copy
Worksheets("Data").Range("C2").PasteSpecial xlPasteValues

Worksheets("FORM TEMPLATE").Range("J10").Copy
Worksheets("Data").Range("D2").PasteSpecial xlPasteValues

Worksheets("FORM TEMPLATE").Range("J11").Copy
Worksheets("Data").Range("E2").PasteSpecial xlPasteValues

Upvotes: 0

Views: 82

Answers (5)

user6432984
user6432984

Reputation:

  • Create an array to hold the data
  • Resize the array to match the number of cells in the range
  • Loop the cells in the range
  • Increment the counter
  • Add the value of the current cell to the array
  • Size the destination range to fit the data and assign the array to this range
Sub LoopData()
    Dim Data()
    Dim x As Long
    Dim c As Range

    With Worksheets("FORM TEMPLATE").Range("D9,D10,J9:J11")
        ReDim Data(1 To .Cells.Count)

        For Each c In .Cells
            x = x + 1
            Data(x) = c.Value
        Next
        Worksheets("Data").Range("B2").Resize(1, UBound(Data)) = Data
    End With

End Sub

Upvotes: 0

Werrf
Werrf

Reputation: 1148

A method I like to use when working with a random set of values that can't be automatically determined is to create an array from a constant. In your case, something like:

Const csSource as string = "D9|D10|J9|J10|J11"

Dim varSource as Variant, i as integer
Dim rngTarget as range

varsource = split(cssource,"|")
set rngTarget = worksheets("Data").range("A2")

for i = 0 to ubound(varSource)
    rngtarget.value = worksheets("Form Template").range(varsource(i)).value
    set rngTarget = rngTarget.offset(0, 1)
next i

You can add new source values in the constant at the top as needed. This is a little more memory heavy than other methods, since it uses variants, but it's a lot easier to code and maintain.

Upvotes: 0

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19847

As JetSetJim said - your source cells aren't easily identified.

Sub Test()

    Dim rToCopy As Range
    Dim rCell As Range
    Dim lColNum As Long

    lColNum = 1
    With ThisWorkbook
        Set rToCopy = .Worksheets("FORM TEMPLATE").Range("D9:D10,J9:J11")
        With .Worksheets("Data")
            For Each rCell In rToCopy
                .Cells(2, lColNum) = rCell.Value
                lColNum = lColNum + 1
            Next rCell
        End With
    End With

End Sub

Upvotes: 0

user4039065
user4039065

Reputation:

Load the values into an array and assign values to the array. After loading the array in an orderly fashion, dump it all back onto the Data worksheet at once.

Sub wqewtry()
    Dim a As Long, arr As Variant

    'preload and shape the array
    With Worksheets("Data")
        arr = .Range("A2:AQ2").Value2
    End With

    With Worksheets("FORM TEMPLATE")
        'use .Value2 for text or numbers; .Value for dates
        a = a + 1: arr(1, a) = .Range("D9").Value2
        a = a + 1: arr(1, a) = .Range("D10").Value2
        a = a + 1: arr(1, a) = .Range("J9").Value2
        a = a + 1: arr(1, a) = .Range("J10").Value2
        a = a + 1: arr(1, a) = .Range("J11").Value2
    End With

    'dump back into the data worksheet
    With Worksheets("Data")
        .Range("A2:AQ2") = arr
    End With

End Sub

This should make it easier to write the code while keeping it organized and making it faster.

Upvotes: 2

JetSetJim
JetSetJim

Reputation: 78

Yes. The following may not be the best code, but it seems your source cells are not contiguously loopable...

Dim SomeArray(X) As String      'Define "X" suitably for your input cells

SomeArray(0) = "D9"
SomeArray(1) = "D10"
SomeArray(2) = "J9"
SomeArray(3) = "J10"
etc...

Then you loop over the source cells array and copy each one:

curOffset=0
For i = LBound(SomeArray) To UBound(SomeArray)
    Worksheets("FORM TEMPLATE").Range(SomeArray(i)).Copy
    Worksheets("Data").Range("A2").Offset(0,curOffset).PasteSpecial xlPasteValues
    curOffset = curOffset + 1
Next i

Upvotes: 1

Related Questions