Excel VBA - Have VBA script loop through rows

Question

I have a VBA script that copies data from one sheet to another. The data copied is put into a formula and the calculated amount is copied back over to the original sheet. I am trying to get it so that the VBA script does this for each row. I have 1000 rows of data.

Sub Rating()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("SoapUI - Single")
Set ws2 = Worksheets("STpremcalc")

        ws2.Range("B3").Value = ws1.Range("B3").Value

        ws2.Range("B4").Value = ws1.Range("C3").Value

        ws2.Range("B5").Value = ws1.Range("D3").Value

        ws2.Range("B6").Value = ws1.Range("E3").Value

        ws2.Range("E3").Value = ws1.Range("F3").Value

        ws2.Range("E4").Value = ws1.Range("G3").Value

        ws2.Range("E5").Value = ws1.Range("H3").Value

        ws2.Range("E6").Value = ws1.Range("I3").Value

        ws2.Range("G3").Value = ws1.Range("J3").Value

        ws2.Range("G4").Value = ws1.Range("K3").Value

        ws2.Range("G5").Value = ws1.Range("L3").Value

        ws2.Range("J3").Value = ws1.Range("N3").Value

        ws2.Range("J4").Value = ws1.Range("O3").Value

        ws2.Range("J6").Value = ws1.Range("P3").Value

        ws2.Range("B9").Value = ws1.Range("Q3").Value

        ws2.Range("C9").Value = ws1.Range("R3").Value

        ws2.Range("D9").Value = ws1.Range("S3").Value

        ws2.Range("E9").Value = ws1.Range("T3").Value

        ws2.Range("B10").Value = ws1.Range("U3").Value

        ws2.Range("C10").Value = ws1.Range("V3").Value

        ws2.Range("D10").Value = ws1.Range("W3").Value

        ws2.Range("E10").Value = ws1.Range("X3").Value

        ws2.Range("B11").Value = ws1.Range("Y3").Value

        ws2.Range("C11").Value = ws1.Range("Z3").Value

        ws2.Range("D11").Value = ws1.Range("AA3").Value

        ws2.Range("E11").Value = ws1.Range("AB3").Value

        ws1.Range("AW3").Value = ws2.Range("M4").Value

        ws1.Range("AX3").Value = ws2.Range("M5").Value

        ws1.Range("AY3").Value = ws2.Range("M6").Value

End Sub

Also I understand that this may be a very inefficient way to perform this task but I dont know how to better it. So if you have a way to make this more efficient, it would be greatly appreciated.

Edit: Update code as per @user3598756 advice

The problem is that the range you are pasting to doesn't seem to have any pattern in terms of where to move to next, so a loop would require a lot of if/else type syntax which would probably be equally as inefficient. — SierraOscar
– SierraOscar, Commented Jul 26, 2016 at 8:06
The only thing that would change is the row number of the copied data. for example should be something like: Sheets("SoapUI - Single").Range("B" & i).Copy Sheets("STpremcalc").Range("B3").PasteSpecial Paste:=xlValues — Ross
– Ross, Commented Jul 26, 2016 at 8:13

Anastasiya-Romanova 秀 · Accepted Answer · 2016-07-26 08:46:41Z

I'm not a fan of copy/ paste procedure, but if you must use it then the following statements

Sheets("SoapUI - Single").Range("B3").Copy
Sheets("STpremcalc").Range("B3").PasteSpecial Paste:=xlValues

Sheets("SoapUI - Single").Range("C3").Copy
Sheets("STpremcalc").Range("B4").PasteSpecial Paste:=xlValues

Sheets("SoapUI - Single").Range("D3").Copy
Sheets("STpremcalc").Range("B5").PasteSpecial Paste:=xlValues

Sheets("SoapUI - Single").Range("E3").Copy
Sheets("STpremcalc").Range("B6").PasteSpecial Paste:=xlValues

can be simplified into

Sheets("SoapUI - Single").Range("B3:E3").Copy
Sheets("STpremcalc").Range("B3").PasteSpecial Paste:=xlValues, Transpose:=True

Other than above, you can simplify

    Sheets("SoapUI - Single").Range("Q3").Copy
    Sheets("STpremcalc").Range("B9").PasteSpecial Paste:=xlValues

    Sheets("SoapUI - Single").Range("R3").Copy
    Sheets("STpremcalc").Range("C9").PasteSpecial Paste:=xlValues

    Sheets("SoapUI - Single").Range("S3").Copy
    Sheets("STpremcalc").Range("D9").PasteSpecial Paste:=xlValues

    Sheets("SoapUI - Single").Range("T3").Copy
    Sheets("STpremcalc").Range("E9").PasteSpecial Paste:=xlValues

into

    Sheets("SoapUI - Single").Range("Q3:T3").Copy
    Sheets("STpremcalc").Range("B9:E9").PasteSpecial Paste:=xlValues

I think you can do the rest by yourself.

EDIT: Since the OP edits his question. The following can be simplified

    ws2.Range("B3").Value = ws1.Range("B3").Value

    ws2.Range("B4").Value = ws1.Range("C3").Value

    ws2.Range("B5").Value = ws1.Range("D3").Value

    ws2.Range("B6").Value = ws1.Range("E3").Value

    ws2.Range("E3").Value = ws1.Range("F3").Value

    ws2.Range("E4").Value = ws1.Range("G3").Value

    ws2.Range("E5").Value = ws1.Range("H3").Value

    ws2.Range("E6").Value = ws1.Range("I3").Value

by using the loop procedure like this

For i = 1 To 4
    ws2.Cells(i + 2, 2) = ws1.Cells(3, i + 1)    'Or you can use `ws1.Cells(3, i + 1).Value2` if you only need the value without its format like date or currency
    ws2.Cells(i + 2, 5) = ws1.Cells(3, i + 5)
Next i

The rest is yours.

user3598756 · Accepted Answer · 2016-07-26 08:12:55Z

1

not much to do but that little can be:

use variables to reference worksheets and improve both code readability and efficiency

Dim ws1 As Worksheet, ws2 As Worksheet    
Set ws1 = Worksheets("SoapUI - Single")
Set ws2 = Worksheets("STpremcalc")

use Range1.Value = Range2.Value pattern to copy/paste values between ranges it'

ws2.Range("B3").Value = ws1.Range("B3").Value
ws2.Range("B4").Value = ws1.Range("C4").Value
...

answered Jul 26, 2016 at 8:12

user3598756

29.5k4 gold badges20 silver badges30 bronze badges

1 Comment

user3598756 Over a year ago

@Ross: it'd be nice of you to give proper feedbacks to people trying helping you

Collectives™ on Stack Overflow

Excel VBA - Have VBA script loop through rows

2 Answers 2

1 Comment

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related