nigelandrewfoster
Well-known Member
- Joined
- May 27, 2009
- Messages
- 747
Hello.
I need to copy columns between worksheets and then provide lookups values from a table. I have ditched Functions and Copy / Paste in favour of:
1) Loading the values to be looked up into a variant array
2) Using WorksheetFunction.Index/Match to populate a second array referencing the first array
3) Dumping the values en bloc into my range
This has worked beautifully, speeding execution eight-fold. However, the values I am retrieving are decimals (to 2 decimal places) and the values populating my range, whether I define the second array as VARIANT or SINGLE, are SINGLES. Hence 18.8 becomes 18.7999992. I could use CDec for an individual value, or loop through the cells, but this would lose me some of my speed gains. Any suggestions for an alternative approach, please?
Thanks for your time
UPDATE - The value actually STORED in the array is accurate. The problem arises when the array is sent to the cells (bold line)
Nigel
I need to copy columns between worksheets and then provide lookups values from a table. I have ditched Functions and Copy / Paste in favour of:
1) Loading the values to be looked up into a variant array
2) Using WorksheetFunction.Index/Match to populate a second array referencing the first array
3) Dumping the values en bloc into my range
This has worked beautifully, speeding execution eight-fold. However, the values I am retrieving are decimals (to 2 decimal places) and the values populating my range, whether I define the second array as VARIANT or SINGLE, are SINGLES. Hence 18.8 becomes 18.7999992. I could use CDec for an individual value, or loop through the cells, but this would lose me some of my speed gains. Any suggestions for an alternative approach, please?
Thanks for your time
UPDATE - The value actually STORED in the array is accurate. The problem arises when the array is sent to the cells (bold line)
Nigel
Code:
Sub Transfer_Order_Data_To_Shipments(wsShipment As Worksheet)
Dim rngUnfulfilled As Range
Dim rngOrders As Range
Dim rngShipments As Range
Dim rngProducts As Range
Dim rngUsedColumn As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim cel As Range
Dim aintPasteOs
Dim strSKU As String
Dim asngDimensions() As Single
Dim avShipmentSKUs() As Variant
Dim avRandom() As Variant
Dim intShipmentCount As Integer
Dim intColumn As Integer
Dim i As Integer
Dim j As Integer
aintPasteOs = Array(4, 1, 5, 6, 7, 8, 9, 10, 11, 12, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33)
wsShipment.[a2:am65535].Delete Shift:=xlUp ' Clear down Shipments sheet
With Worksheets("Orders")
' Sort Orders sheet by Fulfilled, then (Payment) Status and Account Number
.Cells.Sort Key1:=.[g1], Order1:=xlAscending, Key2:=.[f1], Order2:=xlAscending, Key3:=.[b1], Order3:=xlAscending, Header:=xlYes
Set rngOrders = .Range(.[a2], .[a65535].End(xlUp)) ' All orders, order number column
End With
Set rngUnfulfilled = rngFindBlock("unfulfilled", rngOrders.Offset(, 6), False) ' Ship status column
' Transfer data from Order to Shipments
For intColumn = 0 To UBound(aintPasteOs)
avRandom = rngUnfulfilled.Offset(, intColumn - 6).Value
wsShipment.[a2].Offset(, aintPasteOs(intColumn)).Resize(UBound(avRandom)).Value = avRandom
Next
With wsShipment
Set rngShipments = .Range(.[b2], .[b65535].End(xlUp))
End With
intShipmentCount = rngShipments.Rows.Count
ReDim asngDimensions(intShipmentCount, 4)
avShipmentSKUs = Application.Transpose(rngShipments.Offset(, 9))
With Worksheets("Products")
Set rngProducts = .Range(.[a2], .[a65535].End(xlUp))
End With
For i = 0 To intShipmentCount - 1
strSKU = avShipmentSKUs(i + 1)
asngDimensions(i, 0) = WorksheetFunction.Index(rngProducts.Offset(, 8), WorksheetFunction.Match(strSKU, rngProducts, 0))
asngDimensions(i, 1) = WorksheetFunction.Index(rngProducts.Offset(, 9), WorksheetFunction.Match(strSKU, rngProducts, 0))
asngDimensions(i, 2) = WorksheetFunction.Index(rngProducts.Offset(, 10), WorksheetFunction.Match(strSKU, rngProducts, 0))
asngDimensions(i, 3) = WorksheetFunction.Index(rngProducts.Offset(, 11), WorksheetFunction.Match(strSKU, rngProducts, 0))
Next
[B] wsShipment.[n2].Resize(intShipmentCount, 4).Value = asngDimensions[/B]
End Sub
Last edited: