Macro - add worksheet - copy selected rows - sum last row - name WS same as cell info

[jppl2000]

Hello.......Thanks in advance for your help.

Name is Jim.

I have a spreadsheet, at least 500 rows. Data is entered one row at a time, manually. There are 8 columns of data, numbers, dates, descriptions, dollar values. Not all cells in this range will contain data. One column will have the option to qualify to contain a letter "t" as an identifier to that row. Of course not all the rows will have a "t".

When all entries have been made, I would like to create a macro that would add a new worksheet, then copy only the rows that have a "t" entered into the select column. Then sum the last row which has dollar amounts and rename the worksheet to a previous text entry on another sheet in a specific cell.

Been a while since I dabbled in vba but am somewhat familiar. Hope to hear from you soon.

Thanks,

JIM

 

[My Aswer Is This]

Jim when wanting help from us we always need specifics. You gave no specifics.

You said:" There are 8 columns of data" Does this mean columns A to H??

You said: "One column will have the option to qualify to contain a letter "t"" What column has the "t" value

You said: " Then sum the last row which has dollar amounts." Do you mean sum the column of values and put the sum in the last row of that column? And if so Sum what column?

You said: "and rename the worksheet to a previous text entry on another sheet in a specific cell."

There is nothing specific in this. What sheet and what cell?

When you can give specific details we may be able to help you.

 

[jppl2000]

Hello and thanks for the quick response.
The columns are A thru I.
The column with the "T" value is Column E
The column of values is Column I and should be summed at the bottom.
The name of the newly created worksheet should be reflected from a previous worksheet named "Register (4)" and from cell A2.

So, if any row contains a "T" then can I copy specific cells in those rows to the new sheet? Those cells that need to be copied would be from Columns A,B,C.D,G,I.

Thank you,
JIM

 

[My Aswer Is This]

Assuming the sheet with all your data is named "Master"
And also assume the value we are looking for in column "E" is "T"
In one place you said "t" and in another place you said "T"
I used "T"

Try this:

Sub Copy_Row_With_T()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Dim ans As String
ans = Sheets("Register").Range("A2").Value
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Sheets.Add(After:=Sheets(Sheets.Count)).Name = ans
Lastrowa = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Master").Activate
    For i = 1 To Lastrow
        If Sheets("Master").Cells(i, "E").Value = "T" Then
            Application.Union(Cells(i, "A"), Cells(i, "B"), Cells(i, "C"), Cells(i, "D"), Cells(i, "G"), Cells(i, "I")).Copy Destination:=Sheets(ans).Range("A" & Lastrowa)
            Lastrowa = Lastrowa + 1
        End If
    Next
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

I forgot about the summing in previous post.

Try this script:

Sub Copy_Row_With_T()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Dim ans As String
ans = Sheets("Register").Range("A2").Value
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Sheets.Add(After:=Sheets(Sheets.Count)).Name = ans
Lastrowa = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Master").Activate
    For i = 1 To Lastrow
        If Sheets("Master").Cells(i, "E").Value = "T" Then
            Application.Union(Cells(i, "A"), Cells(i, "B"), Cells(i, "C"), Cells(i, "D"), Cells(i, "G"), Cells(i, "I")).Copy Destination:=Sheets(ans).Range("A" & Lastrowa)
            Lastrowa = Lastrowa + 1
        End If
    Next
    
Sheets(ans).Range("F" & Lastrowa).Value = Application.Sum(Sheets(ans).Range("F1:F" & Lastrowa))
Application.ScreenUpdating = True
End Sub

]

 

[jppl2000]

Almost got it working, when I realized I missed explaining another part. For the copy to print on new page, there is a header which should be printed, same columns but this header is on Row 6. Data to be printed begins on Row 9 and runs for 500 or more Rows.

For the current macro, only the header printed to the new sheet. I am trying to reason why when there were sample entries that did not print.

Thanks,

JIM

 

[jppl2000]

I did get the macro working. Thank you. Must I resize the cells manually or could that be included in the macro already? Some cells have alpha characters while some are numeric and the alpha requiring more space. How do I make the summed total two decimal places?

Thanks,

JIM

 

[My Aswer Is This]

I'm not sure what your wanting now. You mentioned nothing in your original post about wanting to print any thing.

Did my script not do what you wanted?

Now if you want something more done you have to explain that in detail.

Or if I'm wrong please show me in your original post where you mentioned anything about printing.

 

[My Aswer Is This]

What does this mean:
Must I resize the cells manually

Do you mean autofit the column width?
If yes then what columns do we want to autofit?

I did get the macro working. Thank you. Must I resize the cells manually or could that be included in the macro already? Some cells have alpha characters while some are numeric and the alpha requiring more space. How do I make the summed total two decimal places?

Thanks,

JIM

 

[My Aswer Is This]

If your wanting the columns resized and the formatting on the cell fixed.
Try this:

As to problems with printing I have no answer on that unless you explain more.

Sub Copy_Row_With_T()
'Modified
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Dim ans As String
ans = Sheets("Register").Range("A2").Value
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Sheets.Add(After:=Sheets(Sheets.Count)).Name = ans
Lastrowa = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Master").Activate
    For i = 1 To Lastrow
        If Sheets("Master").Cells(i, "E").Value = "T" Then
            Application.Union(Cells(i, "A"), Cells(i, "B"), Cells(i, "C"), Cells(i, "D"), Cells(i, "G"), Cells(i, "I")).Copy Destination:=Sheets(ans).Range("A" & Lastrowa)
            Lastrowa = Lastrowa + 1
        End If
    Next
    
With Sheets(ans)
.Range("F" & Lastrowa).Value = Application.Sum(Sheets(ans).Range("F1:F" & Lastrowa))
.Range("F" & Lastrowa).NumberFormat = "00.00"
.Columns("A:F").AutoFit
End With
Application.ScreenUpdating = True
End Sub