CODEWITHSUNDEEP
vbaexcel
Rey Taino
Rey Taino

Reputation: 179

How to use VBA to offset + one column when a specific criteria is met (Loop)

I've created a spreadsheet to calculate time study averages, in which trying to transfer specific information from one sheet to the other, while offsetting a column when a specific criteria is met. I was able to complete a code to retrieve the desired data (avg time) from sheet("Time_Study_Data_Analysis") to sheet("Process_Modeling_Tool"). But I was only able to get all the data to populate in one column.

I would like to offset +1 column after all the "activity tasks" have been populated for each "Process Element".. I will attach my spreadsheet for better clarification, or I can send it via email. Any help will be greatly appreciated. Please contact me if you need further detail. Thank you

Sub Time_Study()
    Rn = 17
    Rn2 = 8

    Do Until Sheets("Time_Study_Data_Analysis").Cells(Rn, 2) = "HARTNESS"
        If Sheets("Time_Study_Data_Analysis").Cells(Rn, 3) = Empty Then
            Rn = Rn + 1
        Else
            Sheets("Process_Modeling_Tool").Cells(Rn2, 2) = Sheets("Time_Study_Data_Analysis").Cells(Rn, 3)
            Sheets("Process_Modeling_Tool").Cells(Rn2, 6) = Sheets("Time_Study_Data_Analysis").Cells(Rn, 14)
            Rn = Rn + 1
            Rn2 = Rn2 + 1
        End If
    Loop
End Sub

SCREENSHOT OF OBJECTIVE

Upvotes: 0

Views: 334

Answers (1)

Scott Craner
Scott Craner

Reputation: 152525

This should do it 

Sub Time_Study()
    Dim rn As Long, rn2 As Long, cl As Long
    rn = 17
    rn2 = 8
    cl = 6 ' if the outpout is off the correct column adjust this.

    Do Until Sheets("Time_Study_Data_Analysis").Cells(rn, 2) = "HARTNESS"
        If Sheets("Time_Study_Data_Analysis").Cells(rn, 3) <> "" And _
            Sheets("Time_Study_Data_Analysis").Cells(rn - 1, 3) = "" Then
                cl = cl + 1
        End If
        If Sheets("Time_Study_Data_Analysis").Cells(rn, 3) = "" Then
            rn = rn + 1
        Else
            Sheets("Process_Modeling_Tool").Cells(rn2, 2) = Sheets("Time_Study_Data_Analysis").Cells(rn, 3)
            Sheets("Process_Modeling_Tool").Cells(rn2, cl) = Sheets("Time_Study_Data_Analysis").Cells(rn, 14)
            rn = rn + 1
            rn2 = rn2 + 1
        End If
    Loop
End Sub

Every time a new group is found it will move over a column. The new group is decided from a full cell preceded by an empty.

I also declared the variables, this is important if your row exceed the integer limit.

As a side note, using the With Block will save a lot of repetitious typing, and shorten some of the longer lines:

Sub Time_Study()
    Dim rn As Long, rn2 As Long, cl As Long
    rn = 17
    rn2 = 8
    cl = 6 ' if the outpout is off the correct column adjust this.
    With Sheets("Time_Study_Data_Analysis")
        Do Until .Cells(rn, 2) = "HARTNESS"
            If .Cells(rn, 3) <> "" And .Cells(rn - 1, 3) = "" Then
                    cl = cl + 1
            End If
            If .Cells(rn, 3) = "" Then
                rn = rn + 1
            Else
                Sheets("Process_Modeling_Tool").Cells(rn2, 2) = .Cells(rn, 3)
                Sheets("Process_Modeling_Tool").Cells(rn2, cl) = .Cells(rn, 14)
                rn = rn + 1
                rn2 = rn2 + 1
            End If
        Loop
    End With
End Sub

Upvotes: 1

Related Questions