syntax of for...next loop

[dpaton05]

Is there anything wrong with the syntax of my for next loop?

Sub cmdCopyr()
Application.ScreenUpdating = False

'declare variables
Dim TableLastRow As Long
Dim LastRow As Long
Dim TableNumberRows As Long
Dim iCounter As Long                                    'counter of for..next loop
Dim tblRows As Integer                                  'number of rows in tblCosting
Dim tblrow As ListRow                                   'specific row in tblCosting
Dim Combo As String                                     'Combo worksheet name
Dim sht As Worksheet
Dim Start As Long                                       'number of first row in tblCosting
Dim Costing As String

'assign values to variables
Set sht = Worksheets("home")

    With sht


        TableLastRow = Split(Sheets("Home").ListObjects("tblCosting").DataBodyRange.Address, "$")(4)            'last row in tblCosting of home sheet
        Combo = Worksheets("Home").Range("Y5")                                                                  'concaternation of cells to get name of worksheet to put data
        LastRow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
        Costing = Worksheets("home").ListObjects("tblCosting")
        
'        TableNumberRows = Rows("tblCosting")                                          'Worksheets("home").ListObjects("tblCosting").Rows.Count
        Start = "5"
        
         
        For iCounter = Start To TableLastRow Step 1
            .ListObjects("tblCosting").Range.Cells(iCounter, 1).Resize(, 10).copy
            With Worksheets(Combo).Cells(LastRow, iCounter)
                .PasteSpecial Paste:=xlPasteValues
                .Columns("A").NumberFormat = "dd/mm/yyyy"
            End With
            .ListObjects("tblCosting").Range.Cells(iCounter, 1).copy
                Worksheets(Combo).Cells(LastRow, 11).PasteSpecial Paste:=xlPasteValues
            .ListObjects("tblCosting").Range.Cells(iCounter, 30).Resize(, 32).copy
                Worksheets(Combo).Cells(LastRow, 14).PasteSpecial Paste:=xlPasteValues
        Next iCounter
        
                'Check if activities is selected in column I
                If Worksheets("home").Range("I5") = "Activities" Then
                    Worksheets(Combo).Range("K" & LastRow).Value = Worksheets("home").Range("AC" & LastRow)          'copy formula to total column if activities are selected
                    
                    'Worksheets(Combo).Range("I" & Lastrow).ClearContents                                            'clear gst component if activities are selected
                Else
                    Worksheets(Combo).Range("L" & LastRow).Formula = "=K" & LastRow & "*.1"                       'if activities are not selected, GST formula will be added in to column H
                    Worksheets(Combo).Range("M" & LastRow).Formula = "=L" & LastRow & "+K" & LastRow               'if activities are not selected, add formula in to column I that will sum columns G + H
                End If
                
            Worksheets(Combo).Columns("H:J").NumberFormat = "$#,##0.00"                                             'format values in columns G to I of Combo
            Call SortDates                                                                                          'format cells to be in ascending date order
    End With
    Application.CutCopyMode = False                                                                         'cancel Cut or Copy mode

    
Application.ScreenUpdating = True
End Sub

Thanks

 

[dpaton05]

Dave

How is it determined which sheet each row is to be copied to?

The extra sheets are labelled as mmmm yyyy, for instance, "August 2018" and the date is entered on the "home" sheet, in the first column of tblCosting as dd/mm/yyyy. Each entry is sorted by the relevant month/year. In other words, if a costing has the date in March 2019, it will go to the March 2019 sheet.

 

[Norie]

Shouldn't you be setting the value of Combo from the first column in the table within the loop?

This code should copy the first 10 columns of each row of the table to the relevant sheet based on the date in the first column

Sub cmdCopyr()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tblrow As ListRow
Dim Combo As String

    Application.ScreenUpdating = False
    
    'assign values to variables
    Set sht = Worksheets("Home")

    With sht

        Set tbl = .ListObjects("tblCosting")
        
        For Each tblrow In tbl.ListRows
            Combo = Format(tblrow.Range.Cells(1, 1), "mmmm yyyy")
            Set wsDst = Sheets(Combo)
            
            With wsDst
                tblrow.Range.Resize(, 10).Copy
                .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            End With
            
        Next tblrow
        
        Call SortDates
        
    End With
    
    Application.CutCopyMode = False

    Application.ScreenUpdating = True
    
End Sub

 

[dpaton05]

Shouldn't you be setting the value of Combo from the first column in the table within the loop?
[/code]

You probably can do this but I didn't know how to do it, so I extracted the year and date, concatenated them together and used that as the name for the sheets. That part is working now and I am a strong believer in the saying, If it ain't broke, don't fix it. I haven't tried the code you wrote yet but I am about to and I will let you know if it doesn't work. Thanks for helping me with that.

 

[dpaton05]

Sht and tbl weren't defined. I worked out that sht was defined as a worksheet but what should I define tbl as?

 

[dpaton05]

Worked it out, Sht was a worksheet and tbl was defined as a listobject. Thanks so much for helping with that. I will see if I can work out getting the extra columns copied, now that I have some correct code that works.

 

[dpaton05]

I can't work out how to get columns O-Q copied from tblCosting and pasted into the sheet in columns K-M. Can you help me with that please?

 

[Norie]

I'm a little confused.

In the original code you only set the value of Combo once, here,

Combo = Worksheets("Home").Range("Y5")

and I don't see any concatenation.

 

[dpaton05]

Sorry about that. Here are the formulas:

Y5: =CONCATENATE(W5," ",X5)
X5: =TEXT(DATE(YEAR(A5),IF(DAY(A5)<26,MONTH(A5),MONTH(A5)+1),1), "yyyy")
W5:=TEXT(DATE(YEAR(A5),IF(DAY(A5)<26,MONTH(A5),MONTH(A5)+1),1), "mmmm")

The reason for the extra code in these formulas is that the reporting month for my work starts on the 26th of the previous month. Everything I have told you relates to one row, so Y5 will be for one costing but Y6 will be combo for the next row.

 

[dpaton05]

What is wrong with this code, to get the extra columns to appear next to the original ones?

            With wsDst
                tblrow.Range.Resize(, 10).copy
                .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                tblrow.Range("O" & tblrow & ":" & "Q" & tblrow).copy
                .Range("A" & Rows.Count).End(xlUp).Offset(11).PasteSpecial xlPasteValues
            End With

 

[dpaton05]

Can someone help me with this code as I don't know how to copy columns O to Q and put them next to the code that is copied. I could copy the entire row but I don't need columns K -N of the home sheet.

tblrow.Range("O" & tblrow & ":" & "Q" & tblrow).copy
.Range("A" & Rows.Count).End(xlUp).Offset(11).PasteSpecial xlPasteValues

This is all of the code, so you can put it in context.

Sub cmdCopyo()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tblrow As ListRow
Dim Combo As String
Dim sht As Worksheet
Dim tbl As ListObject


    Application.ScreenUpdating = False
    
    'assign values to variables
    Set sht = Worksheets("Home")

    With sht

        Set tbl = .ListObjects("tblCosting")
        
        For Each tblrow In tbl.ListRows
            Combo = Format(tblrow.Range.Cells(1, 1), "mmmm yyyy")
            Set wsDst = Sheets(Combo)
            
            With wsDst
                tblrow.Range.Resize(, 32).copy
                .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues                
                tblrow.Range("O" & tblrow & ":" & "Q" & tblrow).copy
                .Range("K" & Rows.Count).End(xlUp).Offset(11).PasteSpecial xlPasteValues
            End With
            
        Next tblrow
        
        Call SortDates
        
    End With
    
    Application.CutCopyMode = False

    Application.ScreenUpdating = True

Thanks