Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
I cannot find what is wrong with this code please Help me
Hi everybody,and thanks in advance
I have the code as follow. What is supposed to do is to delete all the information in tab BackLog_Summary from cell A4 to the end and then copy from certain tabs cells A4 to AZ6 into BackLog_Summary starting in cell A4 the first time and then continue to the last empty row in column A. What happens is that sometimes it works and others delete change headers in row 3, after that if I push the button again it fix it, then again if you push the button it screw up everythin. Sub Backlog() ' ' Backlog Macro ' Dim sh As Worksheet 'Dim DestSh As Worksheet Dim Last As Long Dim CopyRng As Range Dim DeleteRng As String Dim lastRow1 As Long 'With Application ' .ScreenUpdating = False ' .EnableEvents = False 'End With 'Delete information in sheet "BackLog_Summary" if it exist Sheets("BackLog_Summary").Select lastRow1 = Range("A" & Rows.Count).End(xlUp).Row DeleteRng = Range("A4:BA" & lastRow1).Select On Error Resume Next Selection.Delete 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If LCase(Left(sh.Name, 2)) = "es" Or LCase(Left(sh.Name, 2)) = "cs" Then 'Find the last row with data on the DestSh Last = lastRow(Sheets("BackLog_Summary")) 'Fill in the range that you want to copy Set CopyRng = sh.Range("A4:AZ5") 'Test if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count Sheets("BackLog_Summary").Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look at the example below this macro CopyRng.Copy With Sheets("BackLog_Summary").Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the BA column Sheets("BackLog_Summary").Cells(Last + 1, "BA").Resize(CopyRng.Rows.Count).Value = sh.Name End If Next ExitTheSub: Application.Goto Sheets("BackLog_Summary").Cells(1) 'AutoFit the column width in the DestSh sheet Sheets("BackLog_Summary").Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With ' Select Menu Tab Worksheets("Menu").Select End Sub Function lastRow(sh As Worksheet) On Error Resume Next lastRow = sh.Cells.Find(What:="*", _ after:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ after:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
I cannot find what is wrong with this code please Help me
You have a problem here...
DeleteRng = Range("A4:BA" & lastRow1).Select On Error Resume Next Selection.Delete You want to fill the DeleteRng Variable with the address to be deleted? For what purpose since you are only deleting the selection? DeleteRng = "A4:BA" & lastRow1 Range(deleterng).Delete Or Range("A4:BA" & lastRow1).Delete I notice that you are using On error resume next. Generally speaking that is very dangerous code as it will ignore all errors regardless which can cause a lot of damage if an error you did not anticipate occures. -- HTH... Jim Thomlinson "Eduardo" wrote: Hi everybody,and thanks in advance I have the code as follow. What is supposed to do is to delete all the information in tab BackLog_Summary from cell A4 to the end and then copy from certain tabs cells A4 to AZ6 into BackLog_Summary starting in cell A4 the first time and then continue to the last empty row in column A. What happens is that sometimes it works and others delete change headers in row 3, after that if I push the button again it fix it, then again if you push the button it screw up everythin. Sub Backlog() ' ' Backlog Macro ' Dim sh As Worksheet 'Dim DestSh As Worksheet Dim Last As Long Dim CopyRng As Range Dim DeleteRng As String Dim lastRow1 As Long 'With Application ' .ScreenUpdating = False ' .EnableEvents = False 'End With 'Delete information in sheet "BackLog_Summary" if it exist Sheets("BackLog_Summary").Select lastRow1 = Range("A" & Rows.Count).End(xlUp).Row DeleteRng = Range("A4:BA" & lastRow1).Select On Error Resume Next Selection.Delete 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If LCase(Left(sh.Name, 2)) = "es" Or LCase(Left(sh.Name, 2)) = "cs" Then 'Find the last row with data on the DestSh Last = lastRow(Sheets("BackLog_Summary")) 'Fill in the range that you want to copy Set CopyRng = sh.Range("A4:AZ5") 'Test if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count Sheets("BackLog_Summary").Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look at the example below this macro CopyRng.Copy With Sheets("BackLog_Summary").Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the BA column Sheets("BackLog_Summary").Cells(Last + 1, "BA").Resize(CopyRng.Rows.Count).Value = sh.Name End If Next ExitTheSub: Application.Goto Sheets("BackLog_Summary").Cells(1) 'AutoFit the column width in the DestSh sheet Sheets("BackLog_Summary").Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With ' Select Menu Tab Worksheets("Menu").Select End Sub Function lastRow(sh As Worksheet) On Error Resume Next lastRow = sh.Cells.Find(What:="*", _ after:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ after:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
I cannot find what is wrong with this code please Help me
Hi Jim,
Thank you for responding me, I not a VBA expert so with the help of all the good people of the comunity and mixing different answers I got from the comunity I wrote the code given, the sentence on error was there and I read that should be there in the answer, really i have not idea what happens if I take that sentence out, any advise? Why I delete the range, new projects are added and my other code in the userform is creating tabs with the project #, so I need to create a Pivot table with all the projects information so my PV is based on this BackLog_summary tab. It supposed to delete previous information and copy the first 3 rows with information from the project tabs. The modification that you give to me works if I push the button once if I push it two or three times it screw up my headers, not idea why Maybe you have a better suggestion on how to achieve my goal, This is my last step with my userform everything else is working perfectly but not this one. I really appreciate your help. Thanks again "Jim Thomlinson" wrote: You have a problem here... DeleteRng = Range("A4:BA" & lastRow1).Select On Error Resume Next Selection.Delete You want to fill the DeleteRng Variable with the address to be deleted? For what purpose since you are only deleting the selection? DeleteRng = "A4:BA" & lastRow1 Range(deleterng).Delete Or Range("A4:BA" & lastRow1).Delete I notice that you are using On error resume next. Generally speaking that is very dangerous code as it will ignore all errors regardless which can cause a lot of damage if an error you did not anticipate occures. -- HTH... Jim Thomlinson "Eduardo" wrote: Hi everybody,and thanks in advance I have the code as follow. What is supposed to do is to delete all the information in tab BackLog_Summary from cell A4 to the end and then copy from certain tabs cells A4 to AZ6 into BackLog_Summary starting in cell A4 the first time and then continue to the last empty row in column A. What happens is that sometimes it works and others delete change headers in row 3, after that if I push the button again it fix it, then again if you push the button it screw up everythin. Sub Backlog() ' ' Backlog Macro ' Dim sh As Worksheet 'Dim DestSh As Worksheet Dim Last As Long Dim CopyRng As Range Dim DeleteRng As String Dim lastRow1 As Long 'With Application ' .ScreenUpdating = False ' .EnableEvents = False 'End With 'Delete information in sheet "BackLog_Summary" if it exist Sheets("BackLog_Summary").Select lastRow1 = Range("A" & Rows.Count).End(xlUp).Row DeleteRng = Range("A4:BA" & lastRow1).Select On Error Resume Next Selection.Delete 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If LCase(Left(sh.Name, 2)) = "es" Or LCase(Left(sh.Name, 2)) = "cs" Then 'Find the last row with data on the DestSh Last = lastRow(Sheets("BackLog_Summary")) 'Fill in the range that you want to copy Set CopyRng = sh.Range("A4:AZ5") 'Test if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count Sheets("BackLog_Summary").Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look at the example below this macro CopyRng.Copy With Sheets("BackLog_Summary").Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the BA column Sheets("BackLog_Summary").Cells(Last + 1, "BA").Resize(CopyRng.Rows.Count).Value = sh.Name End If Next ExitTheSub: Application.Goto Sheets("BackLog_Summary").Cells(1) 'AutoFit the column width in the DestSh sheet Sheets("BackLog_Summary").Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With ' Select Menu Tab Worksheets("Menu").Select End Sub Function lastRow(sh As Worksheet) On Error Resume Next lastRow = sh.Cells.Find(What:="*", _ after:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ after:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Find number - where did I go wrong? | Excel Programming | |||
FIND method doesn't work in UDF. What's wrong with this code? | Excel Programming | |||
What is wrong with this code? | Excel Programming | |||
What's wrong w/my code? | Excel Programming | |||
Can anyone find what is wrong with the following? | Excel Programming |