Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

problem delete number format into multiple columns after run the macro

0

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 ?

Answer
Discuss

Answers

0
Selected Answer

Leap

Assuming you want to set that for columns F:K on the Summary sheet, just add:

Columns("F:K").NumberFormat = "#,###.00"
before the line Application.ScreenUpdating = True
Discuss

Discussion

thanks  very  much !
leap (rep: 46) Jan 16, '22 at 2:33 am
Glad it helps.
John_Ru (rep: 6102) Jan 16, '22 at 2:33 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login