VBA Loop

[RachelLee]

ID	Part	Min	Max
a	123	1	1
b	456	1	1

<tbody>
</tbody>

Can someone help me with vba looping code to start with a spreadsheet that looks like the above, and end with a spreadsheet like below? (This is an example, but we have numerous ID and parts, so would need "to last row" -- )

ID	Part	Min	Max
a	123	1	1
a	456	1	1
b	123	1	1
b	456	1	1

<tbody>
</tbody>

 

[wideboydixon]

Can you explain in words the logic of what you want to happen? I can only guess what you're after based on the example above.

WBD

 

[Roderick_E]

Sub loopit()
Dim sourcesh As String
Dim destsh As String
Dim cnt As Long
Dim x As Long
Dim y As Long
'----configurations to set-----
sourcesh = "Sheet1" 'change to exact name of source sheet
destsh = "Sheet2" 'change to exact name of destination sheet
cnt = 2 'change to row where data should begin on destsh
'---------
lastrow = Sheets(sourcesh).Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
cnt = 2 'start at second row on new sheet
For x = 2 To lastrow 'change 2 to whatever row your data begins
For y = 1 To 2
If y = 1 Then
Sheets(destsh).Cells(cnt, 1) = "a"
Else
Sheets(destsh).Cells(cnt, 1) = "b"
End If
Sheets(destsh).Cells(cnt, 2) = Sheets(sourcesh).Cells(x, 2) 'add as many rows as you need
'Copy line above and change 2 to next column(s) as needed.


cnt = cnt + 1
Next y
Next x
End Sub

Then sort the column with a & b and you're good to go.

 

[MickG]

Try this for results starting "G1".

[COLOR=navy]Sub[/COLOR] MG15Mar22
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 4)
Ray = Application.Index(Rng.Value, Evaluate("Row(1:" & Rng.Rows.Count & ")"), Array(2, 3, 4))
c = 2
Range("G1").Resize(, 4).Value = Array("ID", "Part", "Min", "Max")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng.Columns(1).Cells
    Cells(c, "G").Resize(Rng.Rows.Count).Value = Dn
    Cells(c, "H").Resize(Rng.Rows.Count, 3).Value = Ray
    c = c + Rng.Rows.Count
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[RachelLee]

Thank you, Roderick. I tried running it, and getting "variable not defined" - on last row =

 

[Roderick_E]

oops

dim lastrow as long

put that up there with the rest of the dimwits

 

[RachelLee]

Thank you, MickG!!!! It worked!!!!!! I wanted it to go to a different sheet - but I can use this as is. Thanks so much!!!

 

[MickG]

You're welcome
Change sheet name to suit :-

[COLOR="Navy"]Sub[/COLOR] MG15Mar47
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 4)
Ray = Application.Index(Rng.Value, Evaluate("Row(1:" & Rng.Rows.Count & ")"), Array(2, 3, 4))
c = 2
With Sheets("Sheet11") '[COLOR="Green"][B] Change sheet name to suit!![/B][/COLOR]
    .Range("A1").Resize(, 4).Value = Array("ID", "Part", "Min", "Max")
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Columns(1).Cells
        .Cells(c, "A").Resize(Rng.Rows.Count).Value = Dn
        .Cells(c, "B").Resize(Rng.Rows.Count, 3).Value = Ray
        c = c + Rng.Rows.Count
   [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[RachelLee]

Thank you - that's awesome. So I have one last problem.... The Part column has mixed formatting.... some of them have an apostrophe in front of them, and they won't download into our min/max table without them. But this vba is getting rid of the apostrophe. So, some of the parts need an apostrophe and some do not. Is there a way that I can keep the 3rd column from changing the formatting of the parts?

 

[MickG]

Not sure why that should be but:-
The previous code created an array for column 2 to 4, this code copies the range over then overwrites column 1.
Hopefully it should do the job.

[COLOR="Navy"]Sub[/COLOR] MG15Mar44
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] rng2 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 4)
c = 2
With Sheets("Sheet11") '[COLOR="Green"][B] Change sheet name to suit!![/B][/COLOR]
    .Range("A1").Resize(, 4).Value = Array("ID", "Part", "Min", "Max")
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Columns(1).Cells
        Rng.Copy .Cells(c, "A")
        .Cells(c, "A").Resize(Rng.Rows.Count).Value = Dn
        c = c + Rng.Rows.Count
   [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick