I need to write the same data into two different range of cells for a VBA application that I am writing. I could of course just loop through twice and write the data, but I was hoping to do it in one pass.
This is an example of what I am doing (lot of complexity removed).
Sub WriteData()
WriteOutDivision "Division1",10
WriteOutDivision "Division1",20
End Sub
Private Sub WriteOutDivision(ByVal divisionName, ByVal rowNumber)
Dim curSheet As Worksheet
Set curSheet = Sheets("Company Scorecard")
With curSheet.Cells(rowNumber, 1)
.value = divisionName
.Font.Bold = True
.InsertIndent 1
End With
End Sub
Is there something that I can do to write to both row 10 column 1 and row 20 column 1 at the same time?
You could define a non-contigous range and change the propeties of the range. For example:
Dim curSheet As Worksheet
Dim rngSpecial As Range
Set curSheet = Sheets("Company Scorecard")
Set rngSpecial = curSheet.Range("A1,A3")
rngSpecial.Value = "Whatever"
Will write "Whatever" in A1 and A3.
Could you just pass an array of row numbers instead of one rowNumber, then in your function just loop through each element in the array (I don't remember, I haven't programed in VBA for a while)? Then you could print it to as many rows as you want.
Related
I've created a loop where I want it to continue to loop until the active cell is empty. If the active cell is not empty I want it to copy the contents of cell "C2" (from a different sheet) into cell "D5".
The Active Cell range is "G5" and the destination is "D5" I want both to offset so check "G6" and paste to "D6".
And so on until the Active Cell("G6" in this example) is empty and stop the loop.
I have provided some code which should help with what ive tried to explain above. I just want the loop to check the Active Cell is not empty and then paste the contents to the destination. Most basic terms every time it loops I want the "D5" to change to D6".
Sub FormatFile_Click()
Dim raw As Worksheet
Dim formula As Worksheet
Set raw = ThisWorkbook.Worksheets("Raw")
Set formula = ThisWorkbook.Worksheets("Formula")
Range("G5").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
formula.Range("C2").Copy Destination:=raw.Range("D5")
ActiveCell.Offset(1, 0).Select
Loop
End sub
Something like this should do the Job for You.
Sub FormatFile_Click()
Dim raw As Worksheet
Dim formula As Worksheet
Dim i As Integer
Set raw = ThisWorkbook.Worksheets("Raw")
Set formula = ThisWorkbook.Worksheets("Formula")
For i = 5 To raw.Range("G5:G" & raw.Range("G5").End(xlDown).Row).Cells.Count + 5
formula.Range("C2").Copy Destination:=raw.Cells(i, 4)
Next
End Sub
Always try to avoid usage of Select & Activate in VBA
You could skip the loop and go much faster with something like this: (untested)
dim fla as string
fla = worksheets("formula").range("c2").formulaR1C1
worksheets("raw").range("G5:G60000").Specialcells(xlCellTypeConstants).formulaR1C1 = fla
Unfortunately using While or Until with range is a bit complicated. I would suggest using the following:
Dim raw As Worksheet
Dim formulaSht As Worksheet
Dim i as Long
dim Idest as Long
Set raw = ThisWorkbook.Worksheets("Raw")
(I changed the worksheet formula to FormulaSht just to make differentiate it from the formula command)
Set formulaSht = ThisWorkbook.Worksheets("Formula")
'instead of selecting the range define it in the loop!
' g5 is cells(5,7)
' Range("G5").Select
i = 5
'I'm setting the destination row as 2 ii (feel free to change it, also you can modify the 'column number, for the below I'll match column d = 4, if you want the copied row to be the same as the pasted row than you can use the same variable for both as save the tiniest bit of memory
Idest = 2
' Set Do loop to stop when an empty cell is reached.
Do Until Cells(i,7) = ""
formulaSht.cells(i,7).Copy Destination:=raw.cells(Idest,4)
i = i+1
Idest = Idest + 1
Loop
End sub
So I have a big excel sheet with a bunch of empty cells in various locations. I want an easy to work with list of which cells are empty. I was hoping to make a new worksheet that was populated with the locations of the empty cells. I wanted to have this to just populate the cells I want it to. I kept the header from the worksheet I will be checking and added a blank cells count, so I want the following cells in the column to be populated by the list of empty cell locations.
Now I know I can use =ISBLANK to test if a cell is empty or not, but I only care about the cells that return TRUE. So I figure I'll need a loop. And I want the location of the cell so I can use =CELL. And to make this most readable I want to do this on a column by column basis.
But I want to populate a spreadsheet with this information in a manner similar to how functions work (I just want to copy and paste it to other cells and columns). But it's pretty clear that I am going to need VBA.
My question is how can I create a macro to populate my spreadsheet with a list of empty cells? How do I apply it to the cells?
I assume you have data in sheet1, I have used sample range// Range("A1:c15") however you can define range as per need and blank cells address will be published in next sheet.
Sub FindBlank()
Dim rng As Range
dim i as long
For Each rng In Sheet1.Range("A1:c15").SpecialCells(xlCellTypeBlanks)
i = i + 1
Sheet2.Cells(i, 1) = rng.Address
Next
End Sub
If you want a list of the cells that are empty, you can use Range().SpecialCells(xlCellTypeBlank):
Sub getEmptyCellAddresses()
Dim rng As Range
Dim ws as Worksheet
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15").SpecialCells(xlCellTypeBlanks) ' Edit/change range as necessary
ws.Cells(1, 2).Value = rng.Cells.Address ' Change `ws.cells(1, 2)` to whatever destination you like
End Sub
Edit: Ah, beaten by 16 seconds by #RamAnuragi ...but anyways, they're slightly different ways to tackle the question so I'll leave it.
Edit: For funsies, here's another way to put them all in a column, one row per cell...and more, per your comments.
Sub listEmptyCells()
Dim emptyAddresses() As String
Dim i As Long
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15")
If WorksheetFunction.CountBlank(rng) = 0 Then
MsgBox ("No empty cells in the range")
Exit Sub
End If
emptyAddresses() = Split(rng.SpecialCells(xlCellTypeBlanks).Address, ",")
For i = LBound(emptyAddresses) To UBound(emptyAddresses)
ws.Cells(i + 1, 2).Value = emptyAddresses(i)
Next i
End Sub
I am working on a workbook where there are 8 worksheets.
Names of worksheets:
[Hierarchy, wins, outlook, pcv, misses, losses, backdate, login].
In "Hierarchy" worksheet I want to apply the formula in a column B, up to the last value of that column B (which includes names of sales person). (I guess we will use a loop, I'm not sure which loop should I use.)
=COUNTIFS(wins!$AL:$AL,Hierarchy!$B4,wins!$P:$P,"Complete")
PS: I need help in above countif formula and loop (in VBA) to use that formula up to the last record in the column.
If you just need a result as opposed to filling formulas down the column in a worksheet, you could use one of these options:
Fast one - only using loops:
Sub countifs_in_vba()
Dim Result As Long
Dim i As Long
Dim cell As Range
Dim wsHierarchy As Worksheet
Dim wsWins As Worksheet
Set wsHierarchy = ThisWorkbook.Sheets("Hierarchy")
Set wsWins = ThisWorkbook.Sheets("wins")
For Each cell In Intersect(wsHierarchy.Range("B:B"), wsHierarchy.UsedRange)
For i = 1 To wsWins.Cells.SpecialCells(xlCellTypeLastCell).Row
If cell.Value = wsWins.Cells(i, "AL").Value And wsWins.Cells(i, "P").Value = "Complete" Then
Result = Result + 1
End If
Next
Next
MsgBox Result
End Sub
Slower one - employing Application.WorksheetFunction:
Sub countifs_in_vba2()
Dim Result As Long
Dim cell As Range
Dim wsHierarchy As Worksheet
Dim wsWins As Worksheet
Set wsHierarchy = ThisWorkbook.Sheets("Hierarchy")
Set wsWins = ThisWorkbook.Sheets("wins")
For Each cell In Intersect(wsHierarchy.Range("B:B"), wsHierarchy.UsedRange)
Result = Result + Application.WorksheetFunction.CountIfs(wsWins.Range("AL:AL"), cell.Value, wsWins.Range("P:P"), "Complete")
Next
MsgBox Result
End Sub
To start with I'm not really a wise man. So I was trying to add up two values and display them in a third (that's easy) but I also wanted it to repeat an infinite amount of times (namely that it does the same for every row, let's say I place the result in I5, I want also, on every I under it (I6, I7, I8, etc...)
Should it be:
Private Sub Worksheet_Change()
if IsNumeric(Range("B1").sort) And IsNumeric(Range("B2").sort) then
Dim value1 As Single
Dim value2 As Single
range(I5).sort = value+1 + value2
End Sub
Or as I think I'm horribly mistaken?
You're using the .Sort property of Range where you should be using .Value.
There's a couple of ways to achieve what you're looking to do. First option is to iterate through the range and add the relevant value to each cell like so:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet_Name")
'Set the range below:
Set rng = .Range("I1:I10")
'Loop through range and add cells together
For Each cell In rng
cell.Value = cell.Offset(0, 2) + cell.Offset(0, 1)
Next cell
End Sub
Another way to do it if the values to be added is ordered in for example column A and B would be:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet1")
'Add the first formula to the sheet
.Range("C1").Value = "=SUM(A1+B1)"
'Change the range below to the range to be filled
.Range("C1").AutoFill Destination:=.Range("C1:C10")
End With
End Sub
I have a large number of helper rows taking information from a different sheet using a simple sum function:
=SUM('HIS-WOT'!J36,'HIS-WOT'!J82,'HIS-WOT'!J128)
Is there a macro out there that will allow me to change/offset all the row numbers in a number of selected cells by an equal amount (i.e. 221) to get a formula such as:
=SUM('HIS-WOT'!J257,'HIS-WOT'!J333,'HIS-WOT'!J349)
The amount with which I need to change the various row numbers varies, so the macro would need to have a dialogue box allowing the user to choose by how much the user wants to increase or decrease row numbers.
Thanks!
This code will give create a dummy sheet to copy the formulas over, I liked your question!
Sub test()
Dim nbr As Long, cel As Range, cels As Range, sh As Worksheet
Set cels = Selection
nbr = CLng(InputBox("Enter offset:"))
Set sh = Worksheets.Add
For Each cel In cels
If cel.HasFormula Then
sh.Cells(cel.Row + nbr, cel.Column).FormulaR1C1 = cel.FormulaR1C1
cel.Formula = sh.Cells(cel.Row + nbr, cel.Column).Formula
End If
Next
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End Sub