0

Im new to VBA, so I will geve you some context and purpose of what I hope to achieve. I am copying data from another program (no issues), I then paste it into a WorkSheet that I have coded the formate for the incoming data to nest where I want it to be (looks pretty), I paste by using a UserForm I created (still no issues). I then created another UserForm and use this to sort the data for number of days between date ranges (used VBA with formula) and if no date is present then I assign todays date (Date) all the above works great. My issue is when the user has completed the above, another UserForm pops up to ask if they want to add the overdue data to the report sheet, this is supposed to copy any rows that have todays date (Date) in Column "G" and then paste it to the report sheet row "A1" down

I would appreciate the help, I have tried a few options and searched high and wide on the net, with the following code so far it looks down column 7, currently I have 15 row items to sort through and two of them have todays date. I keep only getting the last of the two required rows with todays date to paste into the report sheet from the data sheet?

Here is the full code so far with your additional code (the first part formates the destination sheet and as you can see it ensures that destination sheet column "G" is set to format "dd/mm/yyyy":

Private Sub CommandButton1_Click() Me.Hide If Sheets("Masri").Visible Then Sheet10.Activate Sheet10.Cells.Clear Sheet10.Cells.ClearFormats Range("A1:I2").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark2 .TintAndShade = -0.499984740745262 .PatternTintAndShade = 0 End With With Selection.Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With Selection.Font.Bold = True Range("A1:I2").Select ActiveCell.FormulaR1C1 = _ "Number of Days between ANSI's Aproved But not Catalogued" Range("A3:I3").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark2 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With Range("A3:I3").Select ActiveCell.FormulaR1C1 = "MASRI" Range("A4").Select ActiveCell.FormulaR1C1 = "Progress" Selection.Font.Bold = True Range("B4").Select ActiveCell.FormulaR1C1 = "ANSI#" Selection.Font.Bold = True Range("C4").Select ActiveCell.FormulaR1C1 = "Area" Selection.Font.Bold = True Range("D4").Select ActiveCell.FormulaR1C1 = "Supplier" Selection.Font.Bold = True Range("E4").Select ActiveCell.FormulaR1C1 = "Description" Selection.Font.Bold = True Range("F4").Select ActiveCell.FormulaR1C1 = "Approved Date" Selection.Font.Bold = True Range("G4").Select ActiveCell.FormulaR1C1 = "Catalogued Date" Selection.Font.Bold = True Range("H4").Select ActiveCell.FormulaR1C1 = "Approved By" Selection.Font.Bold = True Range("I4").Select ActiveCell.FormulaR1C1 = "Days Overdue" Selection.Font.Bold = True Range("A4:I4").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("A4:I4").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorLight2 .TintAndShade = 0.599993896298105 .PatternTintAndShade = 0 End With Range("A1:I4").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Range("G5:G40").NumberFormat = "dd/mm/yyyy" Columns("A:A").ColumnWidth = 18.43 Columns("B:B").ColumnWidth = 12 Columns("C:C").ColumnWidth = 4.43 Columns("D:D").ColumnWidth = 34.86 Columns("E:E").ColumnWidth = 60.71 Columns("F:F").ColumnWidth = 15.14 Columns("G:G").ColumnWidth = 15.14 Columns("H:H").ColumnWidth = 20.57 Columns("I:I").ColumnWidth = 37.86 ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select Range("A1:I2").Select ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select Selection.ShapeRange.IncrementLeft -2.25 Selection.ShapeRange.IncrementTop 0.75 Selection.ShapeRange.IncrementLeft 2.25 Selection.ShapeRange.IncrementTop -0.75 Sheets("Masri").Select Dim FinalRow As Long, lastTargetRow As Long, lastCol As Long, tRow As Long Dim source As String, target As String Dim ThisValue As Date source = "Masri" 'Define your source sheet target = "Reports" 'Define Target sheet FinalRow = Sheets(source).Range("G" & Rows.Count).End(xlUp).Row lastCol = Sheets(source).Cells(1, Columns.Count).End(xlToLeft).Column 'If header in Row 1 lastTargetRow = Sheets(target).Range("G" & Rows.Count).End(xlUp).Row tRow = lastTargetRow + 1 For lRow = 2 To FinalRow ThisValue = Sheets(source).Cells(lRow, 7).Value If ThisValue = tempDate Then For lCol = 1 To lastCol 'Copy entire row Sheets(target).Cells(tRow, lCol).Value = Sheets(source).Cells(lRow, lCol).Value Next lCol tRow = tRow + 1 'THIS IS THE KEY TO NOT JUST COPYING THE LAST RECORD End If Next lRow End If End Sub
Improve this question
3
  • You have an "End If" without an IF .. Also, you might want to see this Q&A that highlights How to Avoid Using Select Statements. stackoverflow.com/questions/10714251/… Commented Dec 26, 2014 at 10:34
  • Also, you really shouldn't revise your code including the answers posted. It's better if you leave your actual original code that caused you to ask the question in the question itself. Let the answers provide the fixes, and on your end on your PC you modify your code. That way, the question will make sense and one can tell what was wrong and what works. Commented Dec 27, 2014 at 2:06
  • You really should check into removing all the select statements that simply set values and properties. I will post one of them in the answer I provided to give you an idea of how to do that. No need to repeat the entire code. Commented Dec 27, 2014 at 4:57

1 Answer 1

Reset to default
1

It looks like your problem is that you are copying the last record over top of the previous one. If you step through your code, you can confirm that theory or not.

Of course, you probably have more code above what was included in your question, judging by the lingering "End If" before the "End Sub". I'm just going to treat this as a stand alone, for the sake of Declaring the Variables, so you know what type they are.

Look at this code, which simplifies things by setting the values, instead of copying and pasting.

It loops through the source sheet, the same way your code does, using a For Loop.
Then performs a conditional test. If the match is found, a nested Loop through all the columns setting the values on the target sheet from the values on the source sheet is done.

note: the last row is being checked by column "C", (3) because your code was showing that. 

Sub ConditionalCopy() Dim FinalRow As Long, lastTargetRow As Long, lastCol As Long, tRow As Long Dim source As String, target As String Dim ThisValue As Date source = "Masri" 'Define your source sheet target = "Reports" 'Define Target sheet FinalRow = Sheets(source).Range("C" & Rows.count).End(xlUp).row lastCol = Sheets(source).Cells(1, Columns.count).End(xlToLeft).column 'If header in Row 1 lastTargetRow = Sheets(target).Range("C" & Rows.count).End(xlUp).row tRow = lastTargetRow + 1 For lRow = 2 To FinalRow ThisValue = Sheets(source).Cells(lRow, 7).Value If ThisValue = Date() Then For lCol = 1 To lastCol 'Copy entire row Sheets(target).Cells(tRow, lCol).Value = Sheets(source).Cells(lRow, lCol).Value Next lCol tRow = tRow + 1 'THIS IS THE KEY TO NOT JUST COPYING THE LAST RECORD End If Next lRow End Sub

UPDATE: After seeing the rest of the code, I'd strongly recommend reducing any select statements.

Here is an example:

Range("F4").Select ActiveCell.FormulaR1C1 = "Approved Date"

This is not required, and is extra work, because you don't need to select the Range to set its formula or any other property. The reason they are there is probably because of a macro being recorded, which is a good place to start. It is simulating you USING the worksheet, instead of just performing the required operations, with a small sheet, you might not notice the difference, other than the screen flicking all over, but in a large sheet, it would definitely cause problems. It's also just not a good practice.

Consider this:

Range("F4").FormulaR1C1 = "Approved Date"

Another example:

Range("A1:I2").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With

Would be revised as this:

With Range("A1:I2") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With

This link How to avoid using Select in Excel Macros provides MORE examples. You can access any property like Selection.Interior, just use the actual selection NAME instead of "Selection". To merge a range, you just say 

Range("A1:I2").Merge 'or Range("A1:I2").Unmerge
Improve this answer
Sign up to request clarification or add additional context in comments.

7 Comments

Hi peege, Thank you for the rapid response, I tryed the code but get a runtime error "Type Mismatch on this line: For lRow = 2 To FinalRow ThisValue = Sheets(source).Cells(lRow, 7).Value
I have also change the "C" to "G" this made no dfference, when I change the number in the code area "For 1Row = 2 To FinalRow" say to a 9 it does not error but still only pastes the last row data but with less column information? I will edit my code above to show the fullcode for this Macro.
The "C" is just checking for the last row. If all the columns have data in them, that shouldn't make a difference. In face, I usually use column "A" for that, but you had your code checking C. column 3..
The data when copied to "Sheet Masri" comes up as cutom format, I have placed code to change the format to"dd/mm/yyyy" after initial data is pasted
I see. Keep in mind, I wrote that code before you updated your original question. So there isn't a tempDate or a variable handling the Date in your revised code. could you verify that you want "Today's" Date to be the tempDate? If so, try Date() in place of tempDate
|

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.