I have a table below that I would like to use Macro (or any method) to obtain the following result:
Original Table
Expected Result
The problem I faced is Column A will not be a fixed number of rows. I would like to highlight the number of rows in column A and automatically sum and merge into column B. Is it possible to do this with VBA / Macro in Excel?
Another Example:
I have 4 Cells in Column A and would like to highlight the 4 Cells then trigger the Macro. It will automatically goes to column B and merged 4 cells in Column B (not column A) and show the SUM of 4 highlighted cells.
The number of cells in column A will not be fixed and depends on the data. This is why I trying to create a macro instead of merge and sum manually.
I have the code that manage to merge highlighted Rows in Column A and merge in Column B. However i have no idea how to proceed with the SUM.
Sub Macro6()
'
' Macro6 Macro
'
' Keyboard Shortcut: Ctrl+l
'
selection.Offset(0, 1).Select
selection.Merge
With selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = Falsex
.ReadingOrder = xlContext
End With
ActiveCell.FormulaR1C1 = "=SUM(RC[-1]:RC[-1])"
End Sub
This should work:
Option Explicit
Sub Macro6()
'
' Macro6 Macro
'
' Keyboard Shortcut: Ctrl+l
Dim mergeCells As Range
Set mergeCells = Selection.Offset(, 1)
With mergeCells
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.Formula = "=SUM(" & Selection.Address & ")"
End With
End Sub
Related
I've been working on a Macro in Excel that should go through every sheet in the workbook, count the number of rows in a given sheet, and then format those rows. The other day I was able to run it successfully, with the macro formatting the entire workbook, however the next time I attempted to run it, the value for the number of rows did not update, and it only formatted the rest of the sheets up to the number of rows in the first sheet (i.e. if the first sheet is 22 rows long, it will format every sheet, but only the first 22 rows of that sheet, leaving the rest unformatted). I have attempted trying some changes to the macro, but cannot figure out how to resolve the issue so that the row counter resets for each sheet it loops through. Any help in trying to get this macro working is appreciated.
The macro as I currently have it written is as follows:
Sub Formatting()
'
' Formatting Macro
'
' Keyboard Shortcut: Ctrl+Shift+F
'
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
With ws
lr = Cells(Rows.Count, "A").End(xlUp).Row
Range("$A$1:$X$" & lr).Select
With Selection.Font
.Name = "Century"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("G:G").Select
Selection.ColumnWidth = 75
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
Cells.EntireRow.AutoFit
Range("A1").Select
End With
Next ws
End Sub
For the sake of making your formatting subroutine more specific, I have pulled out the formatting itself to private subroutines, so you can see what you're working with. You format a designated range and its font, then separately format column G; both of which add bulk to your base functions and are repeated.
Beyond that, I have removed the Select items, aside from the "A1" select to reset position on each sheet.
Imparting my comments on your code (untested):
Sub Formatting()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
With ws
Dim lr as Long: lr = .Cells(.Rows.Count, "A").End(xlUp).Row
DesignatedRangeFormatting .Range("$A$1:$X$" & lr)
ColumnGFormatting .Columns("G")
.Cells.EntireRow.AutoFit
.Select
.Range("A1").Select
End With
Next ws
End Sub
Private Sub DesignatedRangeFormatting(rng as Range)
With rng.Font
.Name = "Century"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With rng
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Private Sub ColumnGFormatting(rng as Range)
With rng
.ColumnWidth = 75
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Edit1: Added .Select before .Range("A1").Select to ensure the current sheet is selected, which resolves the RTE1004.
I have a table from Column A to Column M where I will input new row of data everyday. I have a Macro which enables me to highlight selected cells in Column I and sum to column J including merge. However, I would like to add "Thick Bottom Border" from Column A to Column M after triggering the Macro. In addition, it would be a better if the Selection Cells will go to Column C 1 row below for faster data input.
Image below for your reference:
Expected Result:
Sub Macro6()
'
' Macro6 Macro
'
' Keyboard Shortcut: Ctrl+l
Dim mergeCells As Range
Set mergeCells = selection.Offset(, 1)
With mergeCells
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.Formula = "=SUM(" & selection.Address & ")"
End With
End Sub
If you run the macro recorder, and add your border, you should get something along the lines of:
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
And now that you know how to add a border, you just need to specify the range.
One way would be to get the last row of your selection. Which can be done by looking at the starting row, the amount of selected rows, and then subtracting one, since we are essentially counting the first row twice.
lrow = Selection.Row + Selection.Rows.Count - 1
Since the range in where you want this will always be the same, it's easy enough to hard-code it, by concatenating the Column and the row, using &.
Sub Macro6()
'
' Macro6 Macro
'
' Keyboard Shortcut: Ctrl+l
Dim lRow as Long
Dim mergeCells As Range
Set mergeCells = selection.Offset(, 1)
With mergeCells
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.Formula = "=SUM(" & selection.Address & ")"
End With
lRow = Selection.Row + Selection.Rows.Count - 1
With Range("A" & lRow, "M" & lRow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End Sub
[Template on CBC][1]Hello looking for major help to solve the above problem/issue I have? Not sure how to tweak it or any criterion formula there is to use as i am pretty new to this! Thank you! I use the macro recorder to get the below formula but failed at tweaking it. Tried looking up videos but i failed too HAHA
Basically I have a array of data on the "data" Worksheet and would like to cut it over, and this datas differ from time to time after i import them. So I enlarge the entire range to the bottom so it covers even longer data set if needed but however, since i am inserting the data i would like to insert the rows with data and exclude the empty rows whenever i execute the macro. Mainly the idea behind this macro. Thank you!
'
' Macro1 Macro
'
'
Sheets("Data").Select
Rows("1:4").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveWindow.SmallScroll Down:=93
Rows("1:105").Select
ActiveWindow.SmallScroll Down:=-138
Selection.Cut
Sheets("CBC").Select
ActiveWindow.SmallScroll Down:=-15
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Range("C9").Select
ActiveWindow.SmallScroll Down:=126
Range("C9:C146").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub```
[1]: https://i.stack.imgur.com/OP1Hw.jpg
If I got your goal this should work:
Option Explicit
Sub Test()
With ThisWorkbook.Sheets("Data")
'This will get the last row with data in sheet Data on Column A
Dim LastRow As Long: LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim RangeToCopy As Range
'This will get the whole range to copy to the next sheet
Set RangeToCopy = .Range("A5", .Cells(LastRow, .UsedRange.Columns.Count))
End With
With ThisWorkbook.Sheets("CBC")
'Paste the whole data from RangeToCopy to the CBC sheet
.Range("A4").Resize(RangeToCopy.Rows.Count, RangeToCopy.Columns.Count).Insert xlDown
.Range("A4").Resize(RangeToCopy.Rows.Count, RangeToCopy.Columns.Count).Value = RangeToCopy.Value
RangeToCopy.Delete
End With
End Sub
Sub AddAdjustment()
'
' AddAdjustment Macro
'
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("D:D").Select
With Range("D13").Select
ActiveCell.FormulaR1C1 = "Adjustment 1"
Range("D13").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D18").Select
End Sub
I have a worksheet where I want to insert a column with the name "Adjustment #" at the top of the column. Each time I run the macro I want it to be Adjustment 1, Adjustment 2, Adjustment 3, etc....
How would this be possible? I can insert the columns but I cannot figure out how to make the name advance in number every time. Thanks!
Well, based on your question and provided code - here is the possible solution:
Option Explicit
Sub AddAdjustment()
Static colNo As Long
colNo = colNo + 1
Cells(1, 4).EntireColumn.Insert CopyOrigin:=xlFormatFromLeftOrAbove
With Cells(13, 4)
.Value = "Adjustment " & colNo
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.EntireColumn.AutoFit
End With
Cells(18, 4).Select
End Sub
I have a file that is exported by the system each week that needs to be modified slightly in each sheet and all sheets to be renamed based on one cell in that particular cell (E7). I am not able to get it to loop no matter how hard i try. Any ideas what i am missing? I assume it has to do with that 'konstandst' variable and how i name sheets, but can fix..
Sub Formateraom()
' Format and change name of the sheet
Dim ws As Worksheet
Dim weekNR As Variant
Dim konstnadst As Variant
weekNR = InputBox("What week number is it?")
For Each ws In Worksheets
Set ws = ActiveSheet
konstnadst = Range("E7")
Range("A2:C2").Select
Selection.ClearContents
Range("A5:T5").Select
Selection.ClearContents
Columns("C:C").ColumnWidth = 75#
Rows("5:7").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Columns("H:H").ColumnWidth = 13
Range("H7,M7,G7").Select
Range("G7").Activate
Selection.NumberFormat = "m/d/yyyy"
Columns("M:M").ColumnWidth = 13
Columns("G:G").ColumnWidth = 13
Range("C3").Select
ActiveCell.FormulaR1C1 = weekNR
Range("C4").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C3").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveSheet.Name = "Fakturaunderlag " & konstnadst & " " & weekNR
Next
End Sub
Sending gigantic ball of karma to whoever can point me to the right direction!
Set ws = ActiveSheet would always set the current loop sheet (i.e. ws) to the currently Active one.
this way you'd always get the same sheet, the one being active before the loop begins
so you'd simply have to change
Set ws = ActiveSheet
to
ws.Activate
thus making the current loop sheet the active one
but although tha above patch may (seem to) work, it is also a bad coding habit and you're warmly invited to avoid Activate/ActiveXXX/Select/Selection pattern and switch to a direct and qualified up to the worksheet (and workbook, if there could be more than one open at the time the macro is being run) Range reference
so your code could become the following:
Option Explicit
Sub Formateraom()
' Format and change name of the sheet
Dim ws As Worksheet
Dim weekNR As Variant
Dim konstnadst As Variant
weekNR = InputBox("What week number is it?")
For Each ws In Worksheets
With ws ' reference the current loop sheet. inside the 'With ... End With' block, all its members are accessed by means of a dot (.)
konstnadst = .Range("E7") ' initialize 'konstnadst' to referenced sheet cell E7 value
.Range("A2:C2").ClearContents
.Range("A5:T5").ClearContents
.Columns("C:C").ColumnWidth = 75#
With .Rows("5:7") ' reference referenced sheet rows 5 to 7
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
.Columns("H:H").ColumnWidth = 13
.Range("H7,M7,G7").NumberFormat = "m/d/yyyy"
.Columns("M:M").ColumnWidth = 13
.Columns("G:G").ColumnWidth = 13
.Range("C3").FormulaR1C1 = weekNR
With .Range("C4") ' reference referenced sheet cell C4
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With .Range("C3") ' reference referenced sheet cell C3
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Name = "Fakturaunderlag " & konstnadst & " " & weekNR ' change the name of the referenced sheet
End With
Next
End Sub
The below question is actually a case where you need to use .Select. In almost every other instance, never use it.
Question regarding how to export xlsx as pdf
This question should help you learn how to open an excel file using a file dialog box
I'm unsure of what you want to do with weekNR considering you're doing this with it later:
ActiveCell.FormulaR1C1 = weekNR
So I'm going to ignore it until I get more info about it.
Since konstnadst is a Range object, as you have assigned it, I would suggest declaring it as a Range object, with a reference to the worksheet you're working with, like so:
Dim konstandadst As Range
'you need to Set objects such as Ranges, Worksheets, Workbooks, ect.
Set konstandadst = whateverWsThisIs.Range("E7")
Using Range.Activate is the equivalent of clicking the range, which seems to be useless in your circumstance, so get rid of that.
Using:
Range1.Select
Range2.Select
Range3.Select
Results in you only selecting Range3 when this block finishes.
I would highly suggest never using .Select, and instead create reference variables to your ranges to work with them directly like so:
'these select cell A1
Set MyRange = ws.Range("A1")
Set MyRange = ws.Cells(1,1)
'this selects column B
Set MyRange = ws.Range("B:B")
'this selects the row from A1 to B1
Set MyRange = ws.Range(ws.Cells(1,1), ws.Cells(1,2))
'this selects a table defined from A1 to C2
Set MyRange = ws.Range(ws.Cells(1,1), ws.Cells(2,3))
Don't do this:
For Each ws In Worksheets
Do this because you want to explicitly tell VBA the workbook in which you're referencing the Worksheets collection:
For Each ws In ThisWorkbook.Worksheets
Or if you're a freak like me:
For Each ws In Excel.Application.ThisWorkbook.Worksheets
Here are a few relevant operations you can do with Range objects (more here):
'clears the values in the cells
MyRange.ClearContents
'clears the formatting and formulas in the cells
MyRange.Clear
'adjust column width
MyRange.ColumnWidth = someNumber
'adjust row height
MyRange.RowHeight = someOtherNumber
'eliminate indents (i think)
MyRange.IndentLevel = 0
'change the orientation
MyRange.Orientation = 0
After you have set reference variables to the ranges you want, you can use them like this:
With MyRange
'do the stuff here
End With
Instead of:
With Selection
'bad stuff here, don't do the stuff
End With