I am trying to write a code that would sum up a dynamic range of numbers in two columns.
The problem I am facing is that the data I am exporting never has the same amount of rows, therefore defining a set range, as G1-G10 for example, is pointless.
I've tried several codes found on stack overflow but none seems to work.
Note: The data always starts in G1 and H1.
Ideally the summarized columns needs to be in bold format with "all borders".
Hopefully someone can help!
The code I currently have, that obviously is not going to work, is this;
Sub HGFHGH()
Range("G1:H21").Select
Range("G21").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("G1:H21").Select
Range("H21").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("G21:H21").Select
Range("H21").Activate
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("I20").Select
End Sub
Best regards,
Tor
You'll want to take a look on the forums for finding the last row in vba- this is a very common task that you'll learn to either memorize or know where to go to copy it in the future!
Note in my code swap out the 7 for which ever column you want the last row count to be based off of, most keep it as 1 for column A, I don't know if you have data there, so I put 7 for column G.
Dim Lrow As Integer
Lrow = Cells(Rows.Count, 7).End(xlUp).Row
Range("G1:H" & Lrow).Select
Take note of the process: I'm declaring a variable called Lrow, assigning the row count to it, and then using Lrow instead of hardcoding a row like you did. eg: H21 vs "H" & Lrow.
If you needed to enter a formula in the next blank row, you would then have something like below, where I'm totaling only column G, and putting the answer in the next row. (Lrow +1)
Range("G" & Lrow + 1) = Application.WorksheetFunction.Sum(Range("G1:G" & Lrow))
It looked quite bad as a comment so I'll write it as an answer.
The code Perry Moen gave me resulted in the summary being dynamic and working perfectly.
So now my code for summarizing the columns looks like this;
Dim Lrow As Integer
Lrow = Cells(Rows.Count, 7).End(xlUp).Row
Range("G1:H" & Lrow).Select
Range("G" & Lrow + 1) = Application.WorksheetFunction.Sum(Range("G1:G" & Lrow))
Range("H" & Lrow + 1) = Application.WorksheetFunction.Sum(Range("H1:H" & Lrow))
Now I am trying to make the result from above code formatted to be bold and with "all borders".
Range("G" & Lrow + 1 & ":H" & Lrow + 1).Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("I20").Select
End Sub
It dawned on me that I need to "activate the cells" in order to apply the formatting. It it possible to change "Range("G21").Activate" to just "Range("G").Activate?
Thanks a lot for the help!
Related
I have a code that does a loop through a worksheets, if there is a value 2 inside a cell in column S, then I want to insert a row with a specific layout. I have the code, but it takes ages to complete. I've tried replacing .select function, but because I need a specific layout, I don't know how to avoid this.
LastRowMatchC = Worksheets("Compliance").Cells(Rows.Count, 1).End(xlUp).Row
Dim rngc As Range, rc As Long
Set rngc = Range("S8:S" & LastRowMatchC)
For rc = rngc.Count To 1 Step -1
If rngc(rc).Value = 2 Then
rngc(rc + 1).EntireRow.Insert
rngc(rc + 1).EntireRow.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Next rch
---- updated with more details ---
I have made a vba macro that works fine with Excel 2013, but have error with Excel 2016. The macro is very simple and is taken from "recorded macro": it set borders to some cells.
The problem (I suppose) is that cells included also filtered rows:
column_1
cells(1;1) = "aa"
cells(2;1) = 2
cells(3;1) = 1
cells(4;1) = 2
cells(5;1) = 1
cells(6;1) = 1
filtered with "1" on the first row
enter image description here
So running the following macro,
you have error '1004' on ".weight " row
enter image description here
Giving OK you have:
enter image description here
and if you stop the macro now and try to save the file,
you'll get an error:
enter image description here
Please note that this happens only with Excel 2016, Excel 2013 has no problems
This is the complete macro:
Option Explicit
Sub test()
Sheets(1).Select
Range("A1:A6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin ' ==>>>>ERROR HERE
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Please help
Thx
Change range and try:
Option Explicit
Sub test()
With ThisWorkbook.Worksheets("Sheet1").Range("A1:A6").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
I've been reading Microsoft documentation and it seems the selection is unneccesary. Try this:
sub test()
Range("A1:A6").Borders.LineStyle = xlNone
With Range("A1:A6").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin ' ==>>ERROR HERE
End With
End sub
You may have to throw ActiveWorksheet before the range or a Sheet( "Sheet1") depending on what sheet you are on when the macro runs. Hope this helps.
I would like to format copied cells to all borders, cell align top and cell align left, as well as wrap text.
For borders I tried
With rng.Borders
.LineStyle = xlContinuous
Current Macro:
Sub Copy_Data()
Dim Src As Worksheet, Dst As Worksheet
Dim LastRow As Long, r As Range
Dim CopyRange As Range
Set Src = Sheets("Template")
Set Dst = Sheets("Report")
LastRow = Src.Cells(Cells.Rows.Count, "B").Row
For Each r In Src.Range("B2:B" & LastRow)
If r.Value = "Planning" Or r.Value = "On Hold" Or r.Value = "Planning" Or r.Value = "Gathering Info" Or r.Value = "" Then
If CopyRange Is Nothing Then
Set CopyRange = r.EntireRow
Else
Set CopyRange = Union(CopyRange, r.EntireRow)
End If
End If
Next r
If Not CopyRange Is Nothing Then
CopyRange.Copy Dst.Range("A3")
End If
End Sub
If you record a macro you will get something like this
Range("A1:C10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
The above code can be also be written as. Notice how we use the loop to create the borders. Check what is the value of xlEdgeLeft, xlEdgeTop, xlEdgeBottom.. etc. You will then understand how we use the loop.
Dim rng As Range
'~~> Change this to whatever range you want
Set rng = Sheet1.Range("A1:B10")
With rng
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
For k = 7 To 12
With .Borders(k)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Next
End With
Similarly for wrap text and cell alignment, simply record a macro and edit the code to suit your need :)
I am adding all borders to a certain range, In my case (A6:O6),in excel VBA, the below code works but I'd imagine there would have to be a shorter way to write it. I found a single line of code that puts a border around the whole selection but not around every cell.
Range("A6:O6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
You can use the below statements
Dim myRange As Range
Set myRange = Range("A6:O6")
With myRange.Borders
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Try this. It will add a border around every cell in the range A6:O6.
Sub Macro1()
Dim rng As Range
' Define range
Set rng = Range("A6:O6")
With rng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
.TintAndShade = 0
End With
End Sub
I need to automate the formating of an exported excel worksheet with variable rows and variable columns. It seems so simple but I am stumped. I just need to add borders to all cells in the table.
I'm not terribly confident with VBA but have been searching for a solution to this for a few days with no luck. Plenty of help for fixed ranges, and managed to achieve what I need for a single column but I've hit a wall and can't seem to get the whole range to work.
Example of what I'm trying to do in english:
Add borders to cells in range "A1" to "last column with data in row 1 and last row with data in column A"
Any help is greatly appreciated.
Dave
Perhaps something like:
Sub BoxIt()
Set r = Range("A1").CurrentRegion
With r.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With r.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With r.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With r.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With r.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With r.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub