hi
I search for way to avoid problem delete numberformat after run the macro into sheet summary from column F:K . the number format should like this (#,##0.00)
if I have theses numbers(2000,300000,1500000,100,1.5) should be like this ("2,000.00","300,000.00","1,500,000.00","100.00","1.5.00").
Sub CollateData_v7()
Dim d As Object
Dim ShList As Variant, a As Variant, vals As Variant
Dim i As Long, j As Long
Dim s As String
Dim tm As Double
tm = Timer
Set d = CreateObject("Scripting.Dictionary")
ShList = Split("stock|sales|pur|returns|rss", "|")
For j = 0 To UBound(ShList)
With Sheets(ShList(j))
a = .UsedRange.Value2
For i = 2 To UBound(a)
s = .Cells(i, 2)
If Len(s) > 2 Then
' changed code for value assignment/ addition
If Not d.exists(s) Then
'change array in dictionary, just create dictionary entry
d(s) = Join(Application.Index(a, i, Array(3, 4, 5, 6)), ";") & ";;;;"
Else
vals = Split(d(s), ";")
' see if there's a value against this sheet already
If vals(j + 3) <> "" Then
'if so, add this value
vals(j + 3) = vals(j + 3) + a(i, 6)
Else
'if not, record this value
vals(j + 3) = a(i, 6)
End If
'save updated dictionary entry
d(s) = Join(vals, ";")
End If
End If
Next i
End With
Next j
Application.ScreenUpdating = False
With Sheets("summary")
.UsedRange.EntireRow.Delete
With .Range("B2:C2").Resize(d.Count)
.Value = Application.Transpose(Array(d.Keys, d.Items))
With .Columns(2)
.TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
With .Offset(, 8) ' move one column to right so formula gets only numbers
.FormulaR1C1 = "=RC[-5]-RC[-4]+RC[-3]+RC[-2]-RC[-1]"
.Value = .Value
End With
End With
.Columns(1).TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
With .Columns(0)
.Cells(1).Value = 1
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
End With
End With
With .Range("A1:K1") 'need extra column and RSS adding
.Value = Array("item", "CODE", "BRAND", "TYPE", "MANUFACTURE", "STOCK", "SALES", "PUR", "RETURNS", "RSS", "BALANCE")
.Font.Bold = True
.Interior.Color = RGB(166, 166, 166)
.EntireColumn.AutoFit
End With
With .UsedRange
.BorderAround xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End With
Application.ScreenUpdating = True
'Expand message
MsgBox "Calculated in " & Format(Timer - tm, "0.00") & "s"
End Sub
is there any line code achieve it ?