Loop through each row and show the contents if each row in a msg box

[stirlingmw1]

Morning all

I have a worksheet "To_Email" that could contain up to 50 rows and 26 columns of data. This data has the first three columns detailing items (A - Product ID, B - Category and C - Description (starting at row 1 No Headers)) the remaining columns are the qty's for these items that each shop is holding. I am trying to loop through this data and concatenate each row into 2 cells starting from A51 & B51 so that I can then email the contents of these cells as an email body. The format I am trying to use is

Column A will have data from A to C with " - " as separators and
Column B will have data from columns D to Z with each qty on a separate line

so A51 will look like

1234 - Fruit - Apples

B51 will look like

12 24 30

I can loop through a single column but cannot figure out how to loop through everything and format. I am using a msgbox as output just so i can see whether my code was working.

Sub GenerateString()

For i = 1 To 26
    Range("A" & i).Select
    strString = strString & " " & Selection & vbCrLf
Next i

MsgBox strString

End Sub

Thanks

Steve

 

[Fluff]

How about

Sub stirlingmw()
   Dim Cl As Range
   
   For Each Cl In Range("A1:A50")
      If Cl.Value <> "" Then
         Cl.Offset(50) = Join(Application.Index(Cl.Resize(, 3).Value, 1, 0), " - ")
         Cl.Offset(50, 1).Value = Join(Application.Index(Cl.Offset(, 3).Resize(, 23).Value, 1, 0), vbLf)
      End If
   Next Cl
End Sub

 

[Crystalyzer]

Try this on a copy of your workbook.

Sub GenerateString()
    Dim lr As Long
    Dim i as Long, j as Long
  
    lr = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To lr
        Cells(i, 1) = Cells(1, 2) & " - " & Cells(1, 3) & " - " & Cells(1, 4)
      
        For j = 4 To 26
            If j = 4 Then
                tmpStr = Cells(i, j)
            Else
                tmpStr = tmpStr & Chr(10) & Cells(i, j)
            End If
        Next j
        Range(Cells(i, 3), Cells(i, 26)).Clear
    Next i
End Sub

 

[Fluff]

If you have blank cells in D:Z & don't want blank lines in the output

Sub stirlingmw()
   Dim Cl As Range
   For Each Cl In Range("A1:A50")
      If Cl.Value <> "" Then
         Cl.Offset(50) = Join(Application.Index(Cl.Resize(, 3).Value, 1, 0), " - ")
         Cl.Offset(50, 1).Value = Join(Filter(Evaluate(Replace("index(if(@<>"""",@,false),1,0)", "@", Cl.Offset(, 3).Resize(, 26).Address)), False, False), vbLf)
      End If
   Next Cl
End Sub

 

[sykes]

Steve
As an aside, instead of the (quite annoying, after a while) msgbox to evaluate your code's output, you may wish to experiment with the VBA browser's "Immediate" window.
If it's not already open (normally toward the bottom-left) use "View" from the normal toolbar.
You can easily test lines of code in here, and all sorts of other stuff.
Use the return key to run a line you wish to try.
EG type ?3*5, hit return, and the answer's printed in the line beneath.
msgbox "test" followed by return, will display the messagebox for you.
Application.ActiveCell.Value="Test" with return, will place that text into the active cell etc.

In context, instead of the msgbox, you could use this to analyse your results:

Sub GenerateString()

For i = 1 To 26
    Range("A" & i).Select
    strString = strString & " " & Selection & vbCrLf
Next i

'MsgBox strString
Debug.Print strString

End Sub

...the value of strString will appear in the immediate window, for you.

It can be a very, very handy feature.

HTH

 

[stirlingmw1]

How about

Sub stirlingmw()
   Dim Cl As Range
  
   For Each Cl In Range("A1:A50")
      If Cl.Value <> "" Then
         Cl.Offset(50) = Join(Application.Index(Cl.Resize(, 3).Value, 1, 0), " - ")
         Cl.Offset(50, 1).Value = Join(Application.Index(Cl.Offset(, 3).Resize(, 23).Value, 1, 0), vbLf)
      End If
   Next Cl
End Sub

Fluff

Again, thank you so much, works perfect, thanks for your time.

Steve

 

[stirlingmw1]

Try this on a copy of your workbook.

Sub GenerateString()
    Dim lr As Long
    Dim i as Long, j as Long
 
    lr = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To lr
        Cells(i, 1) = Cells(1, 2) & " - " & Cells(1, 3) & " - " & Cells(1, 4)
     
        For j = 4 To 26
            If j = 4 Then
                tmpStr = Cells(i, j)
            Else
                tmpStr = tmpStr & Chr(10) & Cells(i, j)
            End If
        Next j
        Range(Cells(i, 3), Cells(i, 26)).Clear
    Next i
End Sub

Crystalyzer

Thank you, this works great, but i did have the issue of blank cells as Fluff mentioned, and have gone with fluffs solution.

thank you for your time.

Steve

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[stirlingmw1]

Steve
As an aside, instead of the (quite annoying, after a while) msgbox to evaluate your code's output, you may wish to experiment with the VBA browser's "Immediate" window.
If it's not already open (normally toward the bottom-left) use "View" from the normal toolbar.
You can easily test lines of code in here, and all sorts of other stuff.
Use the return key to run a line you wish to try.
EG type ?3*5, hit return, and the answer's printed in the line beneath.
msgbox "test" followed by return, will display the messagebox for you.
Application.ActiveCell.Value="Test" with return, will place that text into the active cell etc.

In context, instead of the msgbox, you could use this to analyse your results:

Sub GenerateString()

For i = 1 To 26
    Range("A" & i).Select
    strString = strString & " " & Selection & vbCrLf
Next i

'MsgBox strString
Debug.Print strString

End Sub

...the value of strString will appear in the immediate window, for you.

It can be a very, very handy feature.

HTH

Sykes

Thanks for the info. I dont know why I didnt think of some other way of doing it as i often use Console.log do do similar with CSS

 

[sykes]