Home > Software engineering >  Dynamic formatting specific cells in VBA
Dynamic formatting specific cells in VBA

Time:06-02

I am new to VBA and cannot figure out how to dynamically format the total sum and fee cells of a macro I recorded. I need to add highlight, bold, change style to currency, change number format, and borders. The reports are not always the same so the formatting needs to be dynamic. The screenshot below shows what I like the final result to look like. Any help is much appreciated!

Final result

Below is what I currently have so far,

   Range("M1").Activate
   ActiveWindow.SmallScroll ToRight:=9
   Range("A:A,M:M,Q:T,V:V").Select
   Range("V1").Activate
   ActiveWindow.SmallScroll ToRight:=9
   Range("A:A,M:M,Q:T,V:V,X:X,AA:AB").Select
   Range("AA1").Activate
   Selection.Delete Shift:=xlToLeft
   Columns("V:BM").Select
   Selection.Delete Shift:=xlToLeft
   ActiveWindow.ScrollColumn = 1
   Range("A1").Select
   Range(Selection, Selection.End(xlDown)).Select
   Range(Selection, Selection.End(xlToRight)).Select
   Selection.Columns.AutoFit
   ActiveWindow.ScrollColumn = 13
   ActiveWindow.ScrollColumn = 19
   ActiveWindow.ScrollColumn = 11
   ActiveWindow.ScrollColumn = 8
   ActiveWindow.SmallScroll ToRight:=3
   ActiveWindow.ScrollColumn = 8
   ActiveWindow.SmallScroll Down:=129
   Lastrow = ThisWorkbook.Sheets("sheet1").Cells(Rows.Count, 10).End(xlUp).Row
   ThisWorkbook.Sheets("sheet1").Range("I" & Lastrow   1) = "Total Sales"
   ThisWorkbook.Sheets("sheet1").Range("I" & Lastrow   2) = "Total Fee"
   ThisWorkbook.Sheets("sheet1").Range("j" & Lastrow   1) = WorksheetFunction.Sum(ThisWorkbook.Sheets("sheet1").Range("j2:j" & Lastrow))
   ThisWorkbook.Sheets("sheet1").Range("j" & Lastrow   2) = WorksheetFunction.Sum(ThisWorkbook.Sheets("sheet1").Range("j2:j" & Lastrow)) * 0.01

End Sub

CodePudding user response:

Arrange Data Dynamically

Sub ArrangeData()
   
   With ThisWorkbook.Worksheets("Sheet1")
       
       ' Delete columns.
       .Range("A:A,M:M,Q:T,V:V,X:X,AA:AB,AF:BW").Delete Shift:=xlToLeft
   
       ' Totals
       
       ' Calculate
       Dim lRow As Long: lRow = .Cells(.Rows.Count, "J").End(xlUp).Row
       Dim Total As Double: Total = Application.Sum(.Range("J2:J" & lRow))
       
       ' Reference the totals' range (4 cells).
       With .Range("I" & lRow   1, "J" & lRow   2)
           
           ' Write.
           .Cells(1).Value = "Total Sales"
           .Cells(2).Value = Total
           .Cells(3).Value = "Total Fee"
           .Cells(4).Value = Total * 0.01
       
           ' Format
           .Font.Bold = True
           .Interior.Color = vbYellow ' 65535
           .BorderAround xlContinuous
           .Borders(xlInsideVertical).LineStyle = xlContinuous
           .Borders(xlInsideHorizontal).LineStyle = xlContinuous
           .Columns(2).NumberFormat = "[$$-en-US]#,##0.00"
       
       End With
       
       ' Autofit columns.
       Dim lCol As Long: lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
       .Range("A1", .Cells(1, lCol)).EntireColumn.AutoFit
   
   End With
   
End Sub
  • Related