Poundland
12-10-2015, 08:01 AM
Hi Guys,
I need your assistance again please.
I have written some code that using object variables transfers data from one workbook to another, all the code is working as it should with the exception of the line below;
Set FDestn = Range(Destn.Address, Cells(mskuaddress + 48, coladdress + 47)) ' sets the target range on the target sheet
The above code line should have set a copy to range on a specific worksheet but instead sets the range on the active worksheet.
The full code is below, it is only a part of it as the second part is yet to be written.
If you point me in the direction of where I am going wrong I would be most appreciative.
Full code
Sub archive()
' Set the variables
Dim Dte As Range, Data As Range, DBaseSht As Worksheet, DBase As Workbook, LineF As Worksheet
Dim Dept As Range, SubD As Range, Clas As Range, SubC As Range, MSKU As Range, MSKUD As Range, Measure As Range
Dim Rw As Range, Col As Range, Destn As Range, FDestn As Range, Sht As String, MskuRw As Range
' assign workbook and sheet variables
Set LineF = ThisWorkbook.Sheets("Lineflow") ' assigns the Lineflow to a worksheet variable
Set DBase = Workbooks("Developments Database.xlsm") ' assigns the Database to a workbook variable
Set Data = LineF.Range("G8:BB56") ' sets the data from the line flow to be copyed to the target
' assign range variables
Set Dte = LineF.Cells(7, 7) ' assigns the first future date
Set Dept = LineF.Cells(5, 9) ' assigns the department name
Set SubD = LineF.Cells(5, 11) ' assigns the sub department name
Set Clas = LineF.Cells(5, 13) ' assigns the class name
Set SubC = LineF.Cells(5, 15) ' assigns the sub class name
Set MSKU = LineF.Cells(5, 6) ' assigns the master sku
Set MSKUD = LineF.Cells(5, 7) ' assigns the master sku description
'MsgBox (Dept & " " & SubD & " " & Clas & " " & SubC & " " & MSKU & " " & MSKUD & " " & Dte)
' checks to see what department code is and assigns a sht number to reference database
' this will be used primarily for the events lineflow where the sheet name does not match
' the department name in the lineflow due to excel character limitations for naming sheets
Select Case Dept.Value
Case Is = "HOMEWARES (400)"
Sht = Dept.Value
Case Is = "ENTERTAINMENT (150)"
Sht = Dept.Value
Case Is = "DIY (600)"
Sht = Dept.Value
Case Is = "CLOTHING (700)"
Sht = Dept.Value
Case Else
Sht = Dept.Value
End Select
'DBase.Activate
' assigns the databse sheet to the sheet variable
Set DBaseSht = DBase.Sheets(Sht) ' assigns the target sheet to a worksheet variable
' assigns the Rw range to a row in the database
With DBaseSht.Range("H1:ED1")
Set Col = .Find(Dte, LookIn:=xlValues) ' looks for the target date in the target sheet
If Not Col Is Nothing Then
coladdress = Col.Column ' assigns the column number and not the letter in the target sheet to a variable
End If
End With
Set Rw = DBaseSht.UsedRange.Rows.End(xlDown) ' finds the last row in the current used range on the target sheet
RowAddress = Rw.Row + 1 ' assigns the row number plus 1 to give next blank row
' Archive routine is now split into two streams
' Stream 1 is the scenario where the Master sku exists in the database
' Stream 2 is the scenario where the master sku does not exist in the database
' a Find function will determine which stream is used
With DBaseSht.Range("E:E")
Set MskuRw = .Find(MSKU, LookIn:=xlValues) ' looks for the target Master Sku in the target sheet
If Not MskuRw Is Nothing Then
mskuaddress = MskuRw.Row ' assigns the row number to the first instance existing master sku
End If
End With
If MskuRw <> "" Then ' check to see if the master sku was found in the target sheet to determine Stream
' Stream 1 the master sku exists in the database
Set Destn = DBaseSht.Cells(mskuaddress, coladdress) ' sets the target address on the target sheet
Set FDestn = Range(Destn.Address, Cells(mskuaddress + 48, coladdress + 47)) ' sets the target range on the target sheet
FDestn.Value = Data.Value ' copies the lineflow range as values into the target address on the target sheet
Else
' Stream 2
End If
End Sub
I need your assistance again please.
I have written some code that using object variables transfers data from one workbook to another, all the code is working as it should with the exception of the line below;
Set FDestn = Range(Destn.Address, Cells(mskuaddress + 48, coladdress + 47)) ' sets the target range on the target sheet
The above code line should have set a copy to range on a specific worksheet but instead sets the range on the active worksheet.
The full code is below, it is only a part of it as the second part is yet to be written.
If you point me in the direction of where I am going wrong I would be most appreciative.
Full code
Sub archive()
' Set the variables
Dim Dte As Range, Data As Range, DBaseSht As Worksheet, DBase As Workbook, LineF As Worksheet
Dim Dept As Range, SubD As Range, Clas As Range, SubC As Range, MSKU As Range, MSKUD As Range, Measure As Range
Dim Rw As Range, Col As Range, Destn As Range, FDestn As Range, Sht As String, MskuRw As Range
' assign workbook and sheet variables
Set LineF = ThisWorkbook.Sheets("Lineflow") ' assigns the Lineflow to a worksheet variable
Set DBase = Workbooks("Developments Database.xlsm") ' assigns the Database to a workbook variable
Set Data = LineF.Range("G8:BB56") ' sets the data from the line flow to be copyed to the target
' assign range variables
Set Dte = LineF.Cells(7, 7) ' assigns the first future date
Set Dept = LineF.Cells(5, 9) ' assigns the department name
Set SubD = LineF.Cells(5, 11) ' assigns the sub department name
Set Clas = LineF.Cells(5, 13) ' assigns the class name
Set SubC = LineF.Cells(5, 15) ' assigns the sub class name
Set MSKU = LineF.Cells(5, 6) ' assigns the master sku
Set MSKUD = LineF.Cells(5, 7) ' assigns the master sku description
'MsgBox (Dept & " " & SubD & " " & Clas & " " & SubC & " " & MSKU & " " & MSKUD & " " & Dte)
' checks to see what department code is and assigns a sht number to reference database
' this will be used primarily for the events lineflow where the sheet name does not match
' the department name in the lineflow due to excel character limitations for naming sheets
Select Case Dept.Value
Case Is = "HOMEWARES (400)"
Sht = Dept.Value
Case Is = "ENTERTAINMENT (150)"
Sht = Dept.Value
Case Is = "DIY (600)"
Sht = Dept.Value
Case Is = "CLOTHING (700)"
Sht = Dept.Value
Case Else
Sht = Dept.Value
End Select
'DBase.Activate
' assigns the databse sheet to the sheet variable
Set DBaseSht = DBase.Sheets(Sht) ' assigns the target sheet to a worksheet variable
' assigns the Rw range to a row in the database
With DBaseSht.Range("H1:ED1")
Set Col = .Find(Dte, LookIn:=xlValues) ' looks for the target date in the target sheet
If Not Col Is Nothing Then
coladdress = Col.Column ' assigns the column number and not the letter in the target sheet to a variable
End If
End With
Set Rw = DBaseSht.UsedRange.Rows.End(xlDown) ' finds the last row in the current used range on the target sheet
RowAddress = Rw.Row + 1 ' assigns the row number plus 1 to give next blank row
' Archive routine is now split into two streams
' Stream 1 is the scenario where the Master sku exists in the database
' Stream 2 is the scenario where the master sku does not exist in the database
' a Find function will determine which stream is used
With DBaseSht.Range("E:E")
Set MskuRw = .Find(MSKU, LookIn:=xlValues) ' looks for the target Master Sku in the target sheet
If Not MskuRw Is Nothing Then
mskuaddress = MskuRw.Row ' assigns the row number to the first instance existing master sku
End If
End With
If MskuRw <> "" Then ' check to see if the master sku was found in the target sheet to determine Stream
' Stream 1 the master sku exists in the database
Set Destn = DBaseSht.Cells(mskuaddress, coladdress) ' sets the target address on the target sheet
Set FDestn = Range(Destn.Address, Cells(mskuaddress + 48, coladdress + 47)) ' sets the target range on the target sheet
FDestn.Value = Data.Value ' copies the lineflow range as values into the target address on the target sheet
Else
' Stream 2
End If
End Sub