Excel VBA Course

(35% Sale Ends Jan. 26)

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 (35% Discount)

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: 32) Jan 16, '22 at 2:33 am
Glad it helps.
John_Ru (rep: 2867) 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