How can I do this differently and faster

[Poundland]

Guys,

I again call upon your collective wisdom, below is some code I have written and the workbook is attached. The code basically capture objects, compares the objects and then records objects onto a separate worksheet if they meet a given criteria.

The code works and well but it runs slow, it can take up to 30 minutes to run through, and I am looking to improve the speed.

Can you help me... Any help will be greatly appreciated. :yes


Sub Update_Matrix()
Dim rngStore As Range, rngProduct As Range, rngSales As Range, rngStock As Range
Dim shtSales As Worksheet, shtStock As Worksheet, shtMatrix As Worksheet
Dim rngMSDestn As Range, rngMPDestn As Range, rngMSaDestn As Range, rngMStDestn As Range
Dim rngStoreNum As Range, rngStockRw As Range, rngStockCol As Range
Dim shtRange As Worksheet, rngRange As Range, rngVerify As Range

Application.Calculation = xlCalculationManual

With ThisWorkbook
Set shtSales = Sheets("Christmas Sales")
Set shtStock = Sheets("Christmas Stock")
Set shtMatrix = Sheets("Store Matrix")
Set shtRange = Sheets("Range")
End With

Set rngRange = shtRange.Columns(3)

shtMatrix.Range("A2:D500000").ClearContents
Set rngMSDestn = shtMatrix.Cells(2, 1)
Set rngMPDestn = shtMatrix.Cells(2, 2)
Set rngMStDestn = shtMatrix.Cells(2, 3)
Set rngMSaDestn = shtMatrix.Cells(2, 4)

CountProduct = 0

shtStock.Select
For Each rngVerify In shtRange.Range(Cells(2, 3), Cells(2, 3).End(xlDown))
'For Each rngProduct In shtStock.Range(Cells(9, 3), Cells(9, 3).End(xlToRight))

With shtStock.Rows(9)
Set rngProduct = .Find(rngVerify, , , xlWhole)
End With

If Not rngProduct Is Nothing Then

'With rngRange
' Set rngVerify = .Find(rngProduct, , , xlWhole)
'End With
'If Not rngVerify Is Nothing Then

CountProduct = CountProduct + 1
CountStore = 0
shtStock.Select ' added for rngverify speed check

For Each rngStore In shtStock.Range(Cells(11, 2), Cells(11, 2).End(xlDown))
Set rngStoreNum = rngStore.Offset(0, -1)
Set rngStock = shtStock.Cells(rngStore.Row, rngProduct.Column)

With shtSales.Columns(1)
Set rngstockrow = .Find(rngStoreNum, LookIn:=xlValues)
End With

With shtSales.Rows(9)
Set rngStockCol = .Find(rngProduct)
End With

On Error Resume Next
Set rngSales = shtSales.Cells(rngstockrow.Row, rngStockCol.Column)
On Error GoTo 0

'Debug.Print ("Store " & rngStore & " Product " & rngProduct & " Sales " & rngSales & " Stock " & rngStock)
'If Not rngSales Is Nothing Then GoTo SalesnStock Else

On Error Resume Next
If rngSales.Value = "" Then
Set rngSales = shtSales.Cells(1, 1)
On Error GoTo 0

'If Not rngStock Is Nothing Then

If rngStock.Value <> "" Then
rngMSDestn.Value = rngStore.Value
rngMPDestn.Value = rngProduct.Value
rngMStDestn.Value = rngStock.Value
rngMSaDestn.Value = rngSales.Value

Set rngMSDestn = rngMSDestn.Offset(1, 0)
Set rngMPDestn = rngMPDestn.Offset(1, 0)
Set rngMStDestn = rngMStDestn.Offset(1, 0)
Set rngMSaDestn = rngMSaDestn.Offset(1, 0)
Else
If rngStock.Value = "" Or rngStock.Value < 0 Then
Set rngStock = shtSales.Cells(1, 1)
rngMSDestn.Value = rngStore.Value
rngMPDestn.Value = rngProduct.Value
rngMStDestn.Value = rngStock.Value
rngMSaDestn.Value = rngSales.Value

Set rngMSDestn = rngMSDestn.Offset(1, 0)
Set rngMPDestn = rngMPDestn.Offset(1, 0)
Set rngMStDestn = rngMStDestn.Offset(1, 0)
Set rngMSaDestn = rngMSaDestn.Offset(1, 0)
Else
End If
End If
End If

SalesnStock:
CountStore = CountStore + 1
Set rngSales = Nothing
Set rngStock = Nothing
Next rngStore

Else
End If
Next rngVerify

'Next rngProduct

Application.Calculation = xlCalculationAutomatic
Debug.Print ("No of Products = " & CountProduct)
Debug.Print ("No of Stores = " & CountStore)
End Sub

[snb]

Can you describe in pure English what the macro is supposed to accomplish ?

[Poundland]

The macro is designed to capture an item from Column 3 on the Range tab, find the corresponding item in Row 9 of both the Stock and Sales Tab. Once found it then it then finds each store in Column 1 of the Stock Worksheet and then finds the same store in Colum1 of the Sales Worksheet.

Using the Column and Row it then finds the Sales value for each Item Store combination, and each stock value for the same combination.

If the Sales value is Zero and the Stock value is greater than 1 then it captures the Store Name, Item name, Sales Value and Stock value onto the Matrix sheet.
Likewise if the Sales Value is Zero and the Stock value is Zero or Negative then it again captures the Store Name, Item Name, Sales Value and Stock Value onto the Matrix sheet.

I hope that makes sense.

[snb]

This should do the trick (resulting in 114330 lines)


Sub M_snb()
sn = Sheets("christmas stock").Cells(9, 1).CurrentRegion
sp = Sheets("christmas sales").Cells(9, 1).CurrentRegion

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
For jj = 3 To UBound(sn, 2)
.Item(sn(j, 1) & "_" & sn(1, jj)) = Val(sn(j, jj))
Next
Next

For j = 2 To UBound(sp)
For jj = 3 To UBound(sp, 2)
.Item(sp(j, 1) & "_" & sp(1, jj)) = .Item(sp(j, 1) & "_" & sp(1, jj)) - Val(sp(j, jj))
Next
Next

ReDim sq(.Count, 2)
j = 1
For Each it In .keys
sq(j, 0) = Left(it, 4)
sq(j, 1) = Mid(it, 6)
sq(j, 2) = .Item(it)
j = j + 1
Next
Sheets("Store matrix").Cells(2, 1).Resize(.Count, 3) = sq
End With
End Sub

Before running the maco:

- remove freeze panes in all sheets.
- clear the contents of row 8 in the 'christmas stock' and 'christmas sales' sheet.

[Poundland]

Thanks for the Code,

Tried running it on my workbook, but kept getting a Run Type 13 error message Type Mismatch on the below line;


.Item(sn(j, 1) & "_" & sn(1, jj)) = Val(sn(j, jj))


With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
For jj = 3 To UBound(sn, 2)
.Item(sn(j, 1) & "_" & sn(1, jj)) = Val(sn(j, jj))
Next
Next

[Poundland]

I had to trim the data down on the workbook to allow it to be attached to the Thread, on the original workbook, the Stock and Sales worksheets will have some of the same items plus different items, same with the stores.

So I cannot do a simple check one against the other I have to find the corresponding Store and Item combination in each worksheet as they may be in different places in each.

Not sure if that has affected the operation of the code you kindly gave to me.

[Poundland]

Ah, just saw the last past of the post, sorry didn't read write to the end, I can remove the Freeze Frames from my workbook, but I cannot remove row 8 as on the original workbook this is part of a Pivot Table and I cannot change that and have the row blank.

Sorry should have read the entire post, got a little excited with the code... lol

[snb]

You can run the code in a workbook in which you empty row 8 in both sheets. Don't hesitate to experiment.

Where your code takes 30 minutes to finish, mine uses only 4,5 seconds.

Consistency is the fundament of any automation.
You should use the same names in column B of both sheets.

[Poundland]

Thank you for your input, unfortunately the names in Column B of both sheets will invariably always be different, sometimes more in one than in the other as one worksheet is looking at sales, and one worksheet is looking at Stock, so a Store could have Stock and no sales, so may only appear in one worksheet.

Also the products in Row 9 on both Pivot tables would not all be the same, as Stores are holding stock of products that do not sell.

I did remove Row 8 from both worksheets and your code ran through but I did not understand the output, as only 1 value was recorded when I needed both values from each worksheet, also the Store and Products appeared Concatenated in the same cell, when they need to be in separate cells...

Sorry for being picky, I do however need both values and only 1 value is being output.

[Poundland]

So I take it there are no other answers for my issue then?

Other than making all my data uniform which is not an option.