What's a shorter way of writing this code?

Question

I have made this excel VBA code through a macro recording and would like to know a shorter way of writing it with some sort of input loop maybe?

The sheet has two inputs which vary with respect to time, these are found in cells (B5:Y5) and (B8:Y8). The code picks up the first input (B5) and pastes it into its appropriate cell (J16). It then copies the other input (B8) and pastes it into its appropriate cell (N12). The sheet calculates two outputs and the code copies these from cells (H41) and (K41) into a "RESULTS" table at the bottom.

It repeats this for the next column of cells in the "INPUTS" section and keeps going until the end of the inputs.

I understand this is a very crude way of doing this and would greatly appreciate any help.

Keep in mind I am a complete coding noob :)

Sub CopyVariables()
'
' CopyVariables Macro
'

'
    Range("J16").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-11]C[-8]"
        Range("N12").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "=R[-4]C[-12]"
                Range("H41").Select
                Selection.Copy
                Range("E47").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                    Range("K41").Select
                    Application.CutCopyMode = False
                    Selection.Copy
                    Range("E48").Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False


    Range("J16").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-11]C[-7]"
        Range("N12").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "=R[-4]C[-11]"
            Range("H41").Select
            Selection.Copy
            Range("F47").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                    Range("K41").Select
                    Application.CutCopyMode = False
                    Selection.Copy
                    Range("F48").Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False

....

and keeps repeating for each cell individually.

So, have a look at this to avoid using select : https://stackoverflow.com/a/10717999/4961700 — Solar Mike, Jan 20 '19 at 21:07
Hi Z.Siddiqi - welcome to StackOverflow. Please note that if your code is actually working, then Code Review is probably a better place to post your question: https://codereview.stackexchange.com/ — SierraOscar, Jan 20 '19 at 21:19

score 2 · Answer 1 · answered Jan 21 '19 at 00:14

Try the below code (NOT TESTED). let me know if this works

Option Explicit
Sub CreateTestResultTable()

    Application.ScreenUpdating = False 'makes your code go faster, can also disable events and calculation but dont know how it will affect you


    Dim ws As Worksheet

    Dim colInp As Integer, colOut As Integer
    Const t_air_in_Row = 5
    Const RH_in_Row = 8
    Const t_air_out_Row = 47
    Const RH_air_out_Row = 48
    Const TimeIn_Row = 3
    Const TimeOut_Row = 46

    'set starting column
    colInp = 2
    colOut = 5

    Set ws = ActiveSheet

    While ws.Cells(TimeIn_Row, colInp).Value <> "" 'check if time input is not blank - the loop will continue till there are no more values.

        'set values
        ws.Range("J16").Value = ws.Cells(t_air_in_Row, colInp).Value 't_air_in
        ws.Range("N12").Value = ws.Cells(RH_in_Row, colInp).Value 'RH_in

        'calculate the sheet
        ws.Calculate
        DoEvents

        'copy output values into report
        ws.Cells(TimeOut_Row, colOut).Value = ws.Cells(TimeIn_Row, colInp).Value 'time
        ws.Cells(t_air_out_Row, colOut).Value = ws.Range("H41").Value 't_air_out
        ws.Cells(RH_air_out_Row, colOut).Value = ws.Range("K41").Value 'RH_air_out

        'increment column count
        colInp = colInp + 1
        colOut = colOut + 1
    Wend

    Application.ScreenUpdating = True

End Sub

Dy.Lee · Accepted Answer · 2019-01-21T11:00:55.940

1

Try

Sub test()
    Dim vData, vResult()
    Dim c As Integer, i As Integer

    c = Range("b5").End(xlToRight).Column
    vData = Range("b5", Cells(8, c))
    c = UBound(vData, 2)
    ReDim vResult(1 To 2, 1 To c)
    For i = 1 To c
        Range("j16") = vData(1, i)
        Range("n12") = vData(4, i)
        vResult(1, i) = Range("h41")
        vResult(2, i) = Range("k41")
    Next i
    Range("e47").Resize(2, c) = vResult

End Sub

edited Jan 21 '19 at 11:00

answered Jan 20 '19 at 23:56

Dy.Lee

7,527
1
12
14

1

Thanks for your reply. It gives a " Run-time error '1004' " – z-siddiqi Jan 21 '19 at 10:59
@Z.Siddiqi, I entered your cell address incorrectly. b4-> b5, cells (7, c) -> cells (8, c) is correct. I modified the answer. – Dy.Lee Jan 21 '19 at 11:03

What's a shorter way of writing this code?

2 Answers2