Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() I,m trying to use this code to automatic update two workbooks" source.xls" get update from database and i want destination.xls pulled automatic update to sheet name"WPS Detail Dates" on some rows. Please do i run this script in source.xls or destination.xls and why is it showing this error. You will be more than welcome to put in your opinion. Thanks and Appreciate your time. ------------------------------------------------------------ Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) DestSht.Name = "Master" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("Master") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
"Subscript out of range" error for: Workbooks("Test1.xls").Save | Excel Programming | |||
FileCopy Command Giving "Subscript Out of Range" Error Message | Excel Programming | |||
strange "subscript out of range" error! | Excel Programming | |||
SaveAs "subscript out of range" error (COM - SOAP) | Excel Programming | |||
SaveAs "subscript out of range" error (COM - SOAP) | Excel Programming |