Home > Software design >  Looping functions in VBA
Looping functions in VBA

Time:07-26

My goal is to build a looping function that can take the *data and convert it into the *Goal Output

This is as far as I can make it with the code, my fundamental question is how to I nest my code inside of VBA to run 3 lines of code and then skip to line 6

*Data - sheet1

Layout
Machine 1
Work Center 1
Date
Machine 2
Work Center 2
Date

*Output - sheet2

Machine Work Center Date
Machine 1 Work Center 1 Date
Machine 1 Work Center 1 Date

*Goal Output - sheet 3

Machine Work Center Date
Machine 1 Work Center 1 Date
Machine 2 Work Center 2 Date

Code

    Sub Fill_Data()
    
        Sheet2.Activate
        Set ws = Sheets("Sheet1")
        Set ws2 = Sheets("Sheet2")
        emptyrow = Cells(Rows.Count, 1).End(xlUp).Row   1
        
        Dim i As Integer
        
        For i = 1 To 3
          ws.Cells(i, 1).Copy
          ws2.Cells(emptyrow, i).PasteSpecial
        Next i
        emptyrow = emptyrow   1
        
        
    End Sub

CodePudding user response:

The below creates the loop you are asking for, you would just need to modify to your specific need.

    Sub Fill_Data()

    Set ws = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    
    ws.Range("A1").Activate
    emptyrow = Cells(Rows.Count, 1).End(xlUp).Row   1
    
    Dim i As Integer
    Dim x As Integer
    
    x = 1
    
    For i = 1 To emptyrow
      ws.Range(Cells(i, 1), Cells(i   2, 1)).copy
      ws2.Cells(x, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
      i = i   4
      x = x   1
    Next i
    
    End Sub

CodePudding user response:

No need to nest any loops, you just need a couple extra incrementers to track everything.

Sub Fill_Data()
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    
    Set ws = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    
    Dim emptyrow As Long
    Dim lr As Long
    Dim col As Long
    Dim i As Long
    
    With ws2
        emptyrow = .Cells(Rows.Count, 1).End(xlUp).Row   1
        If emptyrow = 2 Then 'Populate Headers
            .Cells(1, 1).Value = "Machine"
            .Cells(1, 2).Value = "Work Center"
            .Cells(1, 3).Value = "Date"
        End If
    End With
    
    col = 1
    With ws
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        
        For i = 1 To lr
            If Not .Cells(i, 1).Value = "" And Not IsEmpty(.Cells(i, 1).Value) Then 'Skip blanks
                ws2.Cells(emptyrow, col).Value = .Cells(i, 1).Value
                If col = 3 Then 'Reset column and increment row
                    col = 1
                    emptyrow = emptyrow   1
                Else
                    col = col   1
                End If
            End If
        Next i
    End With
    
End Sub
  • Related