Don't know how to loop this

[Alex Piotto]

Greetings!
I need to make a loop to copy the values of almost 300 rows (from D6 to D300) and 3 columns (A, B, C) from the ActiveSheet into a yesno message box. To give the user a chance, you know...
I really don't know where to start. Never really used loops before...

Here is my code to give you the idea...

Sub INSERIRE_ENTRATE()

Dim QUA6 As String
Dim UNITAPRO6 As String
QUA6 = ThisWorkbook.Sheets("ENTRATE").Range("D6").Value
UNITAPRO6 = " " + ThisWorkbook.Sheets("ENTRATE").Range("B6").Value + " " + ThisWorkbook.Sheets("ENTRATE").Range("A6").Value

Dim QUA7 As String
Dim UNITAPRO7 As String
QUA7 = ThisWorkbook.Sheets("ENTRATE").Range("D7").Value
UNITAPRO7 = " " + ThisWorkbook.Sheets("ENTRATE").Range("B7").Value + " " + ThisWorkbook.Sheets("ENTRATE").Range("A7").Value

Dim QUA8 As String
Dim UNITAPRO8 As String
QUA8 = ThisWorkbook.Sheets("ENTRATE").Range("D8").Value
UNITAPRO8 = " " + ThisWorkbook.Sheets("ENTRATE").Range("B8").Value + " " + ThisWorkbook.Sheets("ENTRATE").Range("A8").Value

ILTUTTO = QUA6 + UNITAPRO6 + vbNewLine + QUA7 + UNITAPRO7 + vbNewLine + QUA8 + UNITAPRO8 + vbNewLine


'LOOOOOOOOPPPPPPP ?????? HOW? 300 rows down!!!


Dim answer As Integer
answer = MsgBox("TUTTO GIUSTO? SICURO? RICONTROLLA..." + vbNewLine + vbNewLine + ILTUTTO, vbYesNo)
 
If answer = vbNo Then

Exit Sub

Else

'DO SOME STUFF

ThisWorkbook.Sheets("DETTAGLI-ENTRATE").Protect AllowFiltering:=True

ActiveSheet.EnableSelection = xlNoSelection

Application.CutCopyMode = False

Application.ScreenUpdating = True

End If

End Sub

The code works... but obviously for 3 rows only...

And I am unable to put the values of the 3 columns together as one because I get a Mismatch error...

 

[davesexcel]

I don't see how this would work?
If you are combining strings, you need to use "&" not "+"

 

[Alex Piotto]

It works anyway but don't ask me why

 

[Alex Piotto]

But you are very right. Now I cam mix

 

[Trixterz]

This should work but haven't tested it...

Sub INSERIRE_ENTRATE()
    Dim Counter As Integer
    Dim QUA6 As String
    Dim UNITAPRO6 As String
    Dim QUA7 As String
    Dim UNITAPRO7 As String
    Dim QUA8 As String
    Dim UNITAPRO8 As String
    Dim Answer As String
    
    For Counter = 6 To 300 Step 3
    
        QUA6 = ThisWorkbook.Sheets("ENTRATE").Range("D" & Counter).Value
        UNITAPRO6 = " " + ThisWorkbook.Sheets("ENTRATE").Range("B" & Counter).Value + " " + ThisWorkbook.Sheets("ENTRATE").Range("A" & Counter).Value
        
        QUA7 = ThisWorkbook.Sheets("ENTRATE").Range("D" & Counter + 1).Value
        UNITAPRO7 = " " + ThisWorkbook.Sheets("ENTRATE").Range("B" & Counter + 1).Value + " " + ThisWorkbook.Sheets("ENTRATE").Range("A" & Counter + 1).Value
        
        QUA8 = ThisWorkbook.Sheets("ENTRATE").Range("D" & Counter + 2).Value
        UNITAPRO8 = " " + ThisWorkbook.Sheets("ENTRATE").Range("B" & Counter + 2).Value + " " + ThisWorkbook.Sheets("ENTRATE").Range("A" & Counter + 2).Value
        
        ILTUTTO = QUA6 + UNITAPRO6 + vbNewLine + QUA7 + UNITAPRO7 + vbNewLine + QUA8 + UNITAPRO8 + vbNewLine
        
        Answer = MsgBox("TUTTO GIUSTO? SICURO? RICONTROLLA..." + vbNewLine + vbNewLine + ILTUTTO, vbYesNo)
         
        If Answer = vbNo Then
            Exit Sub
        Else
            ThisWorkbook.Sheets("DETTAGLI-ENTRATE").Protect AllowFiltering:=True
            ActiveSheet.EnableSelection = xlNoSelection
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
        End If
        
    Next Counter
End Sub

 

[davesexcel]

One way to combine all the strings.

For me combining strings I have to use "&" possibly different for your region.

Sub Button1_Click()
    Dim sh As Worksheet
    Dim s As String
    Dim spac As String
    Dim LstRw As Long, x As Long
    
    spac = vbNewLine
    
    Set sh = Sheets("ENTRATE")
    
    With sh
        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For x = 6 To LstRw
            
            s = s & .Cells(x, 1).Value & " " & .Cells(x, 2).Value & spac
            
        Next x
        
    End With
    
    MsgBox s
    
End Sub

 

[Alex Piotto]

I only get 3 lines...
but
300 rows (from D6 to D300) and 3 columns (A, B, C)

 

[Alex Piotto]

Davesexcel thanks. I modified your code a bit and it works. Only thing... in column D from row 6 down there are empty cells which I do not need in the message box. How do you filter it?

Sub Button1_Click()
    Dim sh As Worksheet
    Dim s As String
    Dim spac As String
    Dim LstRw As Long, x As Long
    
    spac = vbNewLine
    
    Set sh = Sheets("ENTRATE")
    
    With sh
        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For x = 6 To LstRw
            
            s = s & .Cells(x, 4).Value & " " & .Cells(x, 2) & " " & .Cells(x, 1).Value & spac
            
        Next x
        
    End With
    
    MsgBox s
    
End Sub

 

[davesexcel]

You can check if it is blanks.

    Dim sh As Worksheet
    Dim s As String
    Dim spac As String
    Dim LstRw As Long, x As Long
    Dim d As String
    
    spac = vbNewLine
    
    Set sh = Sheets("ENTRATE")
    
    With sh
        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For x = 6 To LstRw
        d = IIf(.Cells(x, 4).Value = "", "", .Cells(x, 4).Value & " ")
            
            s = s & d & .Cells(x, 2) & " " & .Cells(x, 1).Value & spac
            
        Next x
        
    End With
    
    MsgBox s

 

[Alex Piotto]

Hi... I need to filter in column D and not A... but is not filtering. Yet