PDA

View Full Version : Solved: Macro in Excel to update/overwrite tabs of the same name



Holland
10-31-2008, 06:57 AM
Thank you for all your help MD (mdmackillop) and rbrhodes, I have all the buttons working fine I think.

I am now getting errors when uploading the 2nd request/sheet and so on from the Status_Log sheet or using the Clear button any suggestions. I found out that I am getting errors at the tab level I think.

In other words if I input "PO" into B5 and hit upload it works, if I repeat this same input "PO" into B5 I get an error, how do I get an overwrite if B5 = Sheet tab name somewhat like an update or refresh data so one Sheet tab over writes the other Sheet tab like and update if B5 is the same..

Please see attached spread sheet and please test as I have and am confused by the errors. 10582

Here is the code just in case,

Thank you again for your help and support,
HM


Sub UpLoad_Click()
Dim WS As Worksheet
Dim Rng As Range
Set WS = Sheets("Status_Log")
If WS.Range("B5") = "" Then
MsgBox "Please Enter a MR or PO Number"
Exit Sub
End If
With Sheets("Data")
.Columns("A:F").AutoFilter Field:=1, Criteria1:=WS.Range("B5").Text
Set Rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
If Rng(1).Row = 1 Then
MsgBox "MR or PO Number Not Found, Please Double Check and Re-Enter"
GoTo Exits
End If
WS.Range("B6") = Rng(1).Offset(, 2)
WS.Range("B7") = Rng(1).Offset(, 3)
WS.Range("B8") = Rng(1).Offset(, 4)
Rng.Offset(, 1).Copy
WS.Range("A11").PasteSpecial xlValues
Rng.Offset(, 5).Copy
WS.Range("B11").PasteSpecial xlValues
.Columns("A:F").AutoFilter
.Columns("A:F").AutoFilter

End With
'
Exits:
Sheets("Data").Columns("A:F").AutoFilter
WS.Range("B5").Select
WS.Range("B5").Select
Range("A10").Select

With Worksheets("Status_Log")
.Protect Password:="", userinterfaceonly:=True
'.EnableOutlining = True
.EnableAutoFilter = True
'If .FilterMode Then
' .ShowAllData
'End If
End With
Range("A10:B510").Sort Key1:=Range("A10"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A3:B3").Select

Sheets("Status_Log").Select
Sheets("Status_Log").Copy After:=Sheets(2)
Sheets("Status_Log").Select
Application.Run "'Holland''s Userform Filtered searchMaster1.xls'!Clear_Click"
Sheets("Status_Log (2)").Select

ActiveSheet.Shapes("Button 2").Select
Selection.Delete
ActiveSheet.Shapes("Button 1").Select
Selection.Delete
ActiveSheet.Name = ActiveSheet.Range("B5")

End Sub

mdmackillop
10-31-2008, 10:45 AM
I'm getting errors in your file and it won't open properly.. Can you post it again? Use Manage Attachments in the Go Advanced Reply section. That is the usual method here.

Holland
10-31-2008, 10:52 AM
Hi Md, try it now

rbrhodes
10-31-2008, 01:42 PM
Hi Holland,

Here's a version.

BTW, when you post code here, first click the VBA button on the header, then paste the code between the two 'tags' that show up on your screen.

rbrhodes
10-31-2008, 02:12 PM
Slight change...


Sub UpLoad_Click()

Dim shName As String
Dim WS As Worksheet
Dim Rng As Range


Set WS = Sheets("Status_Log")
If WS.Range("B5") = "" Then
MsgBox "Please Enter a MR or PO Number"
WS.Range("B5").Select
Exit Sub
End If
With Sheets("Data")
.Columns("A:F").AutoFilter Field:=1, Criteria1:=WS.Range("B5").Text
Set Rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
If Rng(1).Row = 1 Then
MsgBox "MR or PO Number Not Found, Please Double Check and Re-Enter"
.Columns("A:F").AutoFilter
With WS.Range("B5")
.ClearContents
.Select
End With
Exit Sub
End If

Application.ScreenUpdating = False

WS.Range("B6") = Rng(1).Offset(, 2)
WS.Range("B7") = Rng(1).Offset(, 3)
WS.Range("B8") = Rng(1).Offset(, 4)
Rng.Offset(, 1).Copy
WS.Range("A11").PasteSpecial xlValues
Rng.Offset(, 5).Copy
WS.Range("B11").PasteSpecial xlValues
.Columns("A:F").AutoFilter
End With
'
Exits:
Sheets("Data").Columns("A:F").AutoFilter
WS.Range("B5").Select

With Worksheets("Status_Log")
.Protect Password:="", userinterfaceonly:=True
'.EnableOutlining = True
.EnableAutoFilter = True
'If .FilterMode Then
' .ShowAllData
'End If
End With
Range("A10:B510").Sort Key1:=Range("A10"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("A3:B3").Select

Sheets("Status_Log").Copy After:=Sheets(2)
Sheets("Status_Log").Select
Application.Run "Clear_Click"
Sheets("Status_Log (2)").Select

shName = Range("B5")
With ActiveSheet
.Shapes("Button 2").Delete
.Shapes("Button 1").Delete
'delete if exist
'On Error Resume Next
'no warning
Application.DisplayAlerts = False
'delete
Sheets(shName).Delete
'reset
Application.DisplayAlerts = True
.Name = ActiveSheet.Range("B5")
End With

Set WS = Nothing
Application.ScreenUpdating = True

End Sub

Holland
11-02-2008, 08:19 PM
Thank you both mdmackillop & Dr, I am still getting errors when it comes to creating the new tabs as well as overwriting the new tabs. I am almost starting to give up. Thank you both for your help and support.

Holland

rbrhodes
11-03-2008, 07:45 PM
Hi Holland,

I forgot to restore 2 lines of code when I finished debugging. Here's the corrected version, commented where i missed the two lines.


Sub UpLoad_Click()

Dim shName As String
Dim WS As Worksheet
Dim Rng As Range


Set WS = Sheets("Status_Log")
If WS.Range("B5") = "" Then
MsgBox "Please Enter a MR or PO Number"
WS.Range("B5").Select
Exit Sub
End If
With Sheets("Data")
.Columns("A:F").AutoFilter Field:=1, Criteria1:=WS.Range("B5").Text
Set Rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
If Rng(1).Row = 1 Then
MsgBox "MR or PO Number Not Found, Please Double Check and Re-Enter"
.Columns("A:F").AutoFilter
With WS.Range("B5")
.ClearContents
.Select
End With
Exit Sub
End If

Application.ScreenUpdating = False

WS.Range("B6") = Rng(1).Offset(, 2)
WS.Range("B7") = Rng(1).Offset(, 3)
WS.Range("B8") = Rng(1).Offset(, 4)
Rng.Offset(, 1).Copy
WS.Range("A11").PasteSpecial xlValues
Rng.Offset(, 5).Copy
WS.Range("B11").PasteSpecial xlValues
.Columns("A:F").AutoFilter
End With
'
Exits:
Sheets("Data").Columns("A:F").AutoFilter
WS.Range("B5").Select

With Worksheets("Status_Log")
.Protect Password:="", userinterfaceonly:=True
'.EnableOutlining = True
.EnableAutoFilter = True
'If .FilterMode Then
' .ShowAllData
'End If
End With
Range("A10:B510").Sort Key1:=Range("A10"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("A3:B3").Select

Sheets("Status_Log").Copy After:=Sheets(2)
Sheets("Status_Log").Select
Application.Run "Clear_Click"
Sheets("Status_Log (2)").Select

shName = Range("B5")
With ActiveSheet
.Shapes("Button 2").Delete
.Shapes("Button 1").Delete
'delete if exist

'//This line was commented out
On Error Resume Next

'no warning
Application.DisplayAlerts = False
'delete
Sheets(shName).Delete

'reset

'//This line was missed by dr
On Error GoTo 0

Application.DisplayAlerts = True
.Name = ActiveSheet.Range("B5")
End With

Set WS = Nothing
Application.ScreenUpdating = True

End Sub

Holland
11-04-2008, 06:17 AM
Hi dr and Thank you, works great tested all last night :) and no errors.
THANK YOU again,

Holland