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