Sum with dynamic range - excel

I am trying to sum the cells from T to X, and insert the result into cell Y. I'm starting at row 50, and I'd like to end at the last possible row in the sheet so that it works dynamically. Unfortunately, by designating the last row in the table the macro stops working. I've read a lot of tutorials, I've even copied the same macros that people have created and it still doesn't work.
Subb Zad()
Dim x As Long
For x = 50 To Cells(Rows.Count, "Y").End(xlUp).Row
Cells(x, "Y").Formula = Replace("=sum(T#:X#)", "#", x)
Next
End Sub

No Need for the loop just apply the relative formula to all rows at once:
Sub Zad()
With ActiveSheet 'good practice to denote the parent sheet even if it is the active sheet
Dim x As Long
x = .Cells(.Rows.Count, "T").End(xlUp).Row 'Use T as Y may be empty
.Range(.Cells(50,"Y"),.Cells(x,"Y")).Formula = "=SUM(T50:X50)"
End With
End Sub

Related

Excel VBA 2 Sheets compare and fill if empty

I got 2 Sheets each with a table.
The tables on those sheets have the same format, same length etc.
Row 1 is the days of the month and column A are the employees.
Now I want to compare those two sheets. Sheet1 is the main, if one cell is empty I would like to check if there is data in Sheet2 same cell. If yes, copy it into Sheet1. If no, leave empty.
Is this possible?
VLOOKUP semms like the simple solution but I cant figure out how to do it with 2 criterias (Name and Date)
For filling empty cell i got this code but dont know if thats the best method.
Sub Fill_empty_cell()
Set MR = Range("C3:X600")
For Each cell In MR
If IsEmpty(cell.Value) = True Then
cell.Value = "VLOOKUP????"
End If
Next
End Sub
Thanks for any help!
Daniel
Try this:
Sub Fill_empty_cell()
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Dim rangeToCheck As Range
Set sheet1 = Sheets("Test1")
Set sheet2 = Sheets("Test2")
Set rangeToCheck = sheet1.Range("A2:D30")
For Each cellToCheck In rangeToCheck
If IsEmpty(cellToCheck.Value) = True Then
cellToCheck.Value = sheet2.Cells(cellToCheck.Row, cellToCheck.Column).Value
End If
Next
End Sub
Here you can set a Range by String...
Yes this is possible the easiest way would be using For loops and defining all cells in the range by number (cells(x,y)) and use an if statements to compare those for the different sheets (eg. sheet1.cells(x,y) to sheet2.cells.(x,y))
The if checks if its empty if sheet2 is empty if will stay empty but if somethings is their it will be put in sheet 1
Sub Fill_empty_cell()
Dim x As Long
Dim y As Long
x = 3
y = 3
For x = 3 To 21 'this is the column number of x I think please check
For y = 3 To 300
If ThisWorkbook.Sheets(1).Cells(y, x) = "" Then
ThisWorkbook.Sheets(1).Cells(y, x) = ThisWorkbook.Sheets(2).Cells(y, x)
End If
Next y
Next x
End Sub

Fill down sheet name in a column in multiple sheets

I have code to insert the sheet name into a field of each sheet (there are 80+ sheets).
I would like to insert the sheet name to a cell and fill down to the last row of each sheet.
I get errors:
Sub nameSheet()
For Each x In Worksheets
x.Range("F2" & LastRow) = x.Name
Next x
End Sub
As #BigBen said, you need to define LastRow
there is a special cell property called xlCellTypeLastCell. This is handy to use, as your last cell can be anywhere. Additionally I would do Lastrow + 1, that way you don't overwrite anything.
Sub nameSheet()
Dim x As Worksheet
For Each x In Worksheets
lastrow = x.Cells.SpecialCells(xlCellTypeLastCell).Row
x.Range("F" & lastrow + 1) = x.Name
Next x
End Sub

Counting number of rows including blank rows until 2 blanks encountered

Currently have a macro which counts the number of rows to use as a variable. Due to new data source which has blank rows this no longer functions.
I need it to continue counting until it hits two blanks which is the end of the data source but also include the blank rows in the count.
I have a macro that counts the number of rows to provide a variable for a separate macro which uses that number for a loop function. Everything was working fine except the new data to count has blank row in between data (which must remain and included in the total row count).
I can figure out how to count non-blanks and full cells separately but can't figure out how to do it together. Any suggestions?
Sub num_rows(nrows As Variant)
Dim numrows
Dim ra As Range
Dim i As Integer
'get number of rows between blank cells
Sheets("4 Gantt Overview").Activate
Set ra = Range("b7")
numrows = Range(ra.Address,Range(ra.Address).End(xlDown)).rows.Count
Range(ra.Address).Select
'establish counting loop
For i = 1 To numrows
ActiveCell.Offset(1, 0).Select
Next
nrows = numrows
Range("b7").Select
End Sub
For a data set of 130 rows and 2 blanks its counting only to 30 rows (the first blank position).
Imagine the following data:
If you want to find the first 2 blanks, you can use .SpecialCells(xlCellTypeBlanks) to fund all blanks in your range (here column A). It will turn something like the selected cells in the image. There are 6 selected areas that you can access with .SpecialCells(xlCellTypeBlanks).Areas.
So if we loop through all these areas For Each Area In .Areas and check their row count If Area.Rows.Count >= 2, we can easily find the area with 2 rows (or at least 2 rows).
The amount of rows (empty or not) is then Area.Row - AnalyzeRange.Row
So we end up with:
Option Explicit
Sub TestCount()
MsgBox CountRowsUntilTwoBlanks(Worksheets("Sheet1").Range("A:A"))
End Sub
Function CountRowsUntilTwoBlanks(AnalyzeRange As Range) As Long
Dim Area As Range
For Each Area In AnalyzeRange.SpecialCells(xlCellTypeBlanks).Areas
If Area.Rows.Count >= 2 Then 'if 2 or more then use >=2, if exactly 2 use =2
CountRowsUntilTwoBlanks = Area.Row - AnalyzeRange.Row
Exit For
End If
Next Area
End Function
So for this example it will return 16 rows.
Note that if your goal is to find the last used row, which in this example would be row 20 then you could just use …
Dim LastRow As Long
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
… to find the last used row in column A. Here LastRow returns 20.
This this macro. It will find first cell that is blank with a following cell blank as well.
Sub stopAtDoubleBlank()
Dim i As Long
i = 2
Do While Range("A" & i).Value <> "" Or Range("A" & i + 1) <> ""
i = i + 1
Loop
MsgBox i
End Sub
You can try something like this too if you want:
Sub lastrow()
Dim lr As Long
lr = ActiveSheet.Rows.Count
Cells(1, lr).Select
Selection.End(xlUp).Select
lr = ActiveCell.Row
End Sub
(go down to the very bottom and jump up to the last not empty row in A cloumn(that can be changed) also you can add something like +1 if you want an empty row at the end)

Summing rows above blank cell until previous blank cell

Hello!
I am trying to build a macro, that finds a blank cell in a range in a single column and sums all cells between this blank cell and the previous blank cell.
I've searched the web a lot, and while others have asked this question, i do not find the answers to them particularly helpful in my situation, as i need this to work through 3500+ rows.
E.g:
4
3
4
BLANK 1
2
5
7
1
BLANK 2
1
4
BLANK 3
In this case the cell called "BLANK 1" would be the sum of the 3 previous rows: 4+3+4=11
"Blank 2" would be 15 and so forth.
The range is "G8:G3561".
Edit
For the quick answer see Mr_Nitrogen's answer. It works beautifully!
However, as I am new to VBA and coding in general I do not know how or why the code works.
I am very eager to obtain a better understanding of VBA, which is why I'm continuing this thread (if allowed to).
Furthermore, I would like to provide evidence for the commenters that I have indeed worked on this myself and that I prefer to build my own code.
It's important for me to understand why my code works or doesn't work, which is why i hope that you still want to help me develop my own code.
I finally found an approach that is logical to me. I know that this is not the simplest way to do it, but I would like to know if it could work.
I've written the following code.
Sub Sum_storage()
Dim rng As Range
Dim cell As Range
Dim cell2 As Range
Dim cell3 As Range
Range("G8").End(xlDown).Offset(1, 0).Select
Set cell = Selection
cell.Value = "temp" 'Finds the first blank cell in column G _
and creates a temporary value in order _
to find the second blank cell
Range("G8").End(xlDown).Offset(1, 0).Select
Set cell2 = Selection
cell.Offset(1, 0).Select
Set cell3 = Selection 'The range i need to sum can _
now be described as "cell3:cell2"
Set rng = Range(Range("cell3"), Range("cell2")) 'The code works until this point
cell2.Value = WorksheetFunction.Sum(rng)
The idea is to define the range i want to sum with multiple variables.
My problem is trying to refer to these variables (and setting them in an easier way than using .Offset).
Is it simply not possible to set a range (rng) based on two previously set ranges?
If this is possible the next step for me is creating some kind of loop that could make this work for all 3500+ rows.
You were on the right track with using End(xlDown).
This one should be a way faster than looping through all cells, because this jumps to the next empty cell and sums via WorksheetFunction.Sum.
Option Explicit
Public Sub DoMyStuff()
Dim ws As Worksheet
Set ws = Worksheets("Tabelle8") 'define your worksheet here
Dim FirstCell As Range
Set FirstCell = ws.Range("G8")
Dim VeryLastCell As Range 'get very last cell as stop criteria
Set VeryLastCell = ws.Cells(ws.Rows.Count, "G").End(xlUp)
Do
Dim LastCell As Range
If FirstCell.Offset(1) = vbNullString Then 'test if there is only one cell to sum
Set LastCell = FirstCell
Else
Set LastCell = FirstCell.End(xlDown)
End If
With LastCell.Offset(1, 0) 'this is the cell we want to write the sum
.Value = Application.WorksheetFunction.Sum(ws.Range(FirstCell, LastCell))
.Interior.Color = RGB(255, 0, 0)
End With
Set FirstCell = LastCell.Offset(2, 0)
Loop While FirstCell.Row < VeryLastCell.Row
End Sub
This isnt that complicated to do with for loop, maybe something like
lastrow = Cells(Rows.Count, "G").End(xlUp).Row
firstrow = 8
TempTotal = 0
for x = firstrow to lastrow + 1
If Cells(x, "G") <> "" Then
TempTotal = TempTotal + Cells(x, "G")
Else: Cells(x, "G") = TempTotal
Cells(x, "G").Interior.ColorIndex = 4
TempTotal = 0
End if
Next x
Ive made an edit to make it a bit simpler
The Logic of the Code:
Define the last row with data in column "G"
Move down cell by cell until that row
If the cell has a value in it, add it to the temporary total.
If it is blank, inset the temporary total and reset the tempTotal to zero
This is the first line, in which we select the very last last cell in column "G", use use End(xlup) on it to get to the last cell with data and use .row to get the row number of that cell
Set up a For loop, which runs the code between "for" and "next x" lines repeatedly while incrementing the value of x from "firstrow" to "lastrow + 1" each time it repeats ( so if firsrow is 1 and lastrow is 100) then it will run the code 100 times with x = 1,2,3,4,5 etc.)
this is the "if" statement, "<>" means does not equal, so we are saying if the cell on row x, col "G" is not equal to "" which is an empty string (or nothing) then we do the next line (add its value to tempTotal)
if the "If" statement isnt true (if the cell is blank) then we do what is under the "Else" and make that cell equal to TempTotal, change its color to green (4 is a colorcode, they go between 1 and 50), and reset the temptotal to 0.

Excel VBA: Copy cells from multiple sheets to a single sheet

I am pretty new to VBA and am trying to automate a process at work where I need to extract select cells from an array of 6 sheets and consolidate them in another sheet. The code I have works, but is kinda "clunky" - I am using the excel copy and paste functions, but can't seem to find a good solution away from the copy-and-paste function. And when I try to add a paste special function, I get an 1004 error. Would love advice on optimising this!
For each sheet to be copied, cells are marked in the first column with "1", "0" or left blank - if the cells are "1" or "0", I copy the other cells in the row to the consolidated sheet. There are some gaps in between rows, so I opted to use a For-Loop instead of a Do-While statement.
I've attached the code as follows:
Sub TEST()
Dim i As Integer 'copying row counter for each sheet to be copied
Dim j As Integer 'pasting row counter in consolidated sheet
Dim cal(1 To 6) As String 'copied sheetname
cal(1) = "Picks"
cal(2) = "Eats"
cal(3) = "Night Out"
cal(4) = "Active"
cal(5) = "Family"
cal(6) = "Arts"
Dim x As Integer
Dim y As Integer 'column for date
Dim z As Integer 'max row to run till
y = 1 'column checked in each sheet where condition for copying is met
z = 300 'number of rows to check in each sheet
j = 1
For x = 1 To 6
For i = 1 To z
If Sheets(cal(x)).Cells(i, y) = "0" Or Sheets(cal(x)).Cells(i, y) = "1" Then
Sheets(cal(x)).Select
Range(Sheets(cal(x)).Cells(i, 2), Sheets(cal(x)).Cells(i, 10)).Select
Selection.Copy
Application.Goto ActiveWorkbook.Sheets(Consolidated).Cells(j, 1)
ActiveSheet.Paste
Else
j = j - 1
End If
j = j + 1
Next i
Next x
End Sub
Again I would love to optimise this code, using another method instead of copy-and-paste. Also I tried:
Application.Goto ActiveWorkbook.Sheets(Consolidated).Cells(j, 1)
ActiveSheet.PasteSpecial Operation:=xlPasteValues
Which resulted in a 1004 error. Would love to know what went wrong.
You're getting the error because you're attempting to paste into the activesheet instead of into a range on the activesheet, and because you have the wrong argument for the PasteSpecial method.
This will work, although it's not what you want to do: (see CopyWithoutClipboard further below for a better alternative)
Sub PasteIntoGoto()
Sheets("sheet1").Range("A1").Copy
Application.Goto ActiveWorkbook.Sheets("Sheet3").Cells(1, 1)
ActiveSheet.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
End Sub
Note the range inserted in between ActiveSheet and PasteSpecial and Paste:= instead of Operation:=.
You're right in wanting to optimize your code. Maybe the most important guideline in Excel VBA development is to never select anything, which can cause all kinds of problems. In your first example, you are using .Select explicitly, and in the second example, .GoTo is effectively doing the same thing.
Rather than selecting a sheet, copying a range, selecting another sheet, and pasting into another range, you can write a copy of the data to the target range (either on the same sheet or on another one) like this:
Sub CopyWithoutClipboard()
Sheets("sheet1").Range("A1").Copy Sheets("sheet2").Range("A1")
End Sub
Obviously you can use variables in place of the hard-coded objects in the snippet above.

Resources