Data Transfered but not to Target sheet

[Poundland]

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

[Poundland]

I have solved this dilemma..

I had to add in another object range variable to capture the end address of my target range, and then reference the target sheet when assigning the full target range to the last object range variable.


The full working code is below, now just to write the second part, so I may be back...

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, EDestn 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 start address on the target sheet
Set EDestn = DBaseSht.Cells(mskuaddress + 48, coladdress + 47) ' sets the target end address on the target sheet
Set FDestn = DBaseSht.Range(Destn.Address, EDestn.Address) ' 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

[Poundland]

I have written the full code now, both Stream 1 and Stream 2, had to make a slight Mod to Stream 1, to determine if Stream 2 needed to be executed or not.

Because I am not actually moving between workbooks the code executes and completes in less than a second.

The full code is below, it works exactly as I intended it to.

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, EDestn As Range, Sht As String, MskuRw As Range
' Target Range Start Variables
Dim DeptDestn As Range, SubDDestn As Range, ClasDestn As Range, SubCDestn As Range, MSKUDestn As Range, MSKUDDestn As Range
' Target Range End Variables
Dim DeptEDestn As Range, SubDEDestn As Range, ClasEDestn As Range, SubCEDestn As Range, MSKUEDestn As Range, MSKUDEDestn As Range
' Target Complete Range Variables
Dim DeptFDestn As Range, SubDFDestn As Range, ClasFDestn As Range, SubCFDestn As Range, MSKUFDestn As Range, MSKUDFDestn As Range
Dim DC As Range, DCDestn As Range, DCEDestn As Range, DCFDestn As Range
' Measure variables
Dim M As Range, MDestn As Range, MEDestn As Range, MFDestn 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
Set M = LineF.Range("A8:A56")   ' assigns the lineflow measures
'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
If rowaddress = 1048577 Then
rowaddress = 2
Else
End If
' 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 Not MskuRw Is Nothing 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 start address on the target sheet
Set EDestn = DBaseSht.Cells(mskuaddress + 48, coladdress + 47) ' sets the target end address on the target sheet
Set FDestn = DBaseSht.Range(Destn.Address, EDestn.Address) ' 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 the master sku does not exist in the database
' captures the target range in the target sheet and puts dept value in place
Set DeptDestn = DBaseSht.Cells(rowaddress, 1)
Set DeptEDestn = DBaseSht.Cells(rowaddress + 48, 1)
Set DeptFDestn = DBaseSht.Range(DeptDestn.Address, DeptEDestn.Address)
DeptFDestn.Value = Dept.Value
' captures the target range in the target sheet and puts subd value in place
Set SubDDestn = DBaseSht.Cells(rowaddress, 2)
Set SubDEDestn = DBaseSht.Cells(rowaddress + 48, 2)
Set SubDFDestn = DBaseSht.Range(SubDDestn.Address, SubDEDestn.Address)
SubDFDestn.Value = SubD.Value
' captures the target range in the target sheet and puts clas value in place
Set ClasDestn = DBaseSht.Cells(rowaddress, 3)
Set ClasEDestn = DBaseSht.Cells(rowaddress + 48, 3)
Set ClasFDestn = DBaseSht.Range(ClasDestn.Address, ClasEDestn.Address)
ClasFDestn.Value = Clas.Value
' captures the target range in the target sheet and puts subc value in place
Set SubCDestn = DBaseSht.Cells(rowaddress, 4)
Set SubCEDestn = DBaseSht.Cells(rowaddress + 48, 4)
Set SubCFDestn = DBaseSht.Range(SubCDestn.Address, SubCEDestn.Address)
SubCFDestn.Value = SubC.Value
' captures the target range in the target sheet and puts MSKU value in place
Set MSKUDestn = DBaseSht.Cells(rowaddress, 5)
Set MSKUEDestn = DBaseSht.Cells(rowaddress + 48, 5)
Set MSKUFDestn = DBaseSht.Range(MSKUDestn.Address, MSKUEDestn.Address)
MSKUFDestn.Value = MSKU.Value
' captures the target range in the target sheet and puts MSKUD value in place
Set MSKUDDestn = DBaseSht.Cells(rowaddress, 6)
Set MSKUDEDestn = DBaseSht.Cells(rowaddress + 48, 6)
Set MSKUDFDestn = DBaseSht.Range(MSKUDDestn.Address, MSKUDEDestn.Address)
MSKUDFDestn.Value = MSKUD.Value
' captures the target range in the target sheet and puts M value in place
Set MDestn = DBaseSht.Cells(rowaddress, 7)
Set MEDestn = DBaseSht.Cells(rowaddress + 48, 7)
Set MFDestn = DBaseSht.Range(MDestn.Address, MEDestn.Address)
MFDestn.Value = M.Value
' captures the target range in the target sheet and puts DC value in place **LINEFLOW PHASE 2**
'Set DCDestn = DBaseSht.Cells(rowaddress, 8)
'Set DCEDestn = DBaseSht.Cells(rowaddress + 48, 8)
'Set DCFDestn = DBaseSht.Range(DCDestn.Address, DCEDestn.Address)
'DCFDestn.Value = DC.Value
Set Destn = DBaseSht.Cells(rowaddress, coladdress) ' sets the target start address on the target sheet
Set EDestn = DBaseSht.Cells(rowaddress + 48, coladdress + 47) ' sets the target end address on the target sheet
Set FDestn = DBaseSht.Range(Destn.Address, EDestn.Address) ' 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
End If
End Sub