I am writing a Macro in Excel which is supposed to delete entire Rows, or add Rows, based on input.
Now the amount of rows to be deleted should be determined based on the amount of Rows which are already there, so say if I have 12 Rows and a cell nearby with a Sum amount of 3, I have used the Cell value so far to determine the amount of Rows to be removed.
|1(A1)| Title (B1)
|1(A2)| Title (B2)
|1(A3)| Title (B3)
|3(A4)| Sum (B4)
Here is the code I am using(the removing part, haven't gotten further yet):
If CInt(TextBox2.Value) = Cells(4, 1) Then
MsgBox ("Values are equal")
ElseIf CInt(TextBox2.Value) < Cells(34, 2) Then
a = Cells(4, 1) - CInt(TextBox2.Value)
For i = 1 To a
Rows(1).EntireRow.Delete
Next
End If
The Problem What I have realised with this is, that the Summation Cell which I use to determine the Amount of Rows to be deleted, will move if I delete a Row, so it will not be at position (4,1) (::A4::) anymore.
My Question: Is there a way to use the cell with an ID which would never
change, or dynamically change the addressed Value of the Cell ?
Thanks a lot in Advance!
If you Set a reference to a cell and delete cells above so that the cell move up, the cell reference will be updated accordingly. See following example:
Function testCellRef()
Dim c As Range, i As Long
Set c = [A18]
For i = 1 To 10
Range("A" & i).EntireRow.Delete
Debug.Print "Deleted row " & i & ", cell Address is now " & c.Address
Next i
End Function
will display in the immediate window:
Deleted row 1, cell Address is now $A$17
Deleted row 2, cell Address is now $A$16
Deleted row 3, cell Address is now $A$15
Deleted row 4, cell Address is now $A$14
Deleted row 5, cell Address is now $A$13
Deleted row 6, cell Address is now $A$12
Deleted row 7, cell Address is now $A$11
Deleted row 8, cell Address is now $A$10
Deleted row 9, cell Address is now $A$9
Deleted row 10, cell Address is now $A$9
Note that the last iteration, the row that is deleted (row 10) is below the cell tracked and so the address doesn't change.
Note also that if you replace [A18] by [A17], you will delete the row with the tracked cell and then the reference will become invalid at the 9th iteration and generate an error at the c.Address call.
You could find the row that contains the Sum formula each time by using something like this:
Columns("A").Find("=SUM", , xlFormulas, , xlRows, xlPrevious).Value
That will search column A, starting at the last row and working up and will return the value of the cell that contains "=SUM". If you have more than one cell with that you may need to change the direction or go another route.
Another option would be adding a variable like the example below:
x = 0
If CInt(TextBox2.Value) = Cells(4 + x, 1) Then
MsgBox ("Values are equal")
ElseIf CInt(TextBox2.Value) < Cells(34 + x, 2) Then
a = Cells(4 + x, 1) - CInt(TextBox2.Value)
For i = 1 To a
Rows(1).EntireRow.Delete
x = x - 1
Next
End If
I assume you also need to change the cell you compare to in column B. When adding a row, just use x = x + 1.
To delete the rows you have to loop backwards, that way the row numbers you assume at the beginning of the loop will remain intact.
Related
I'm trying to have a program that can read a range of cells which consist of 12 cells (let's say: P79, R79, T79, V79, X79, Z79, AB79, AD79, AF79, AH79, AJ79, AL79) and under those cells there are 6 cells (let's say: V81, X81, Z81, AB81, AD81, AF81), the program is looking for whether or not there are values typed in the cells within the described range.
The program should be able to read the cells from left to right on the top row and loop down to the bottom row and read that from right to left.
If all the cells in the top row have values in them, then the program breaks and doesn't read the values in the bottom row.
As the program reads the values from each cell it should create a table consisting of three columns (let's say: M88, N88, O88), the leftmost column should have the cell number (in order of cell as read by the program (whichever cell has a value first in the loop is given the number 1 and then the next cell to have a value is given number 2 etc.). The middle column should have whatever value is written in it's corresponding cell read from the range. The right column should have the value of whatever is to the right of each cell containing a value.
The first value to be read with a value should give the value "Left End" and the last value to read (whether or not it is the 12th cell to have a value in the top row or the leftmost cell to have a value in the bottom row) should give the value "Right end".
An example of what a row from the table could look like:
Cell # Cell Value Position/Left/Right
1 First Left End
This is the code I have so far:
Sub Code()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Integer, j As Integer, k As Integer
' First loop to compare a car to the rest after it
For i = 1 To 12
For j = i + 1 To 12
If Not IsEmpty(ws.Range("Cell_" & i)) And Not IsEmpty(ws.Range("Cell_" & j)) Then
ws.Range("B82").Offset(i).Value = j
Exit For
End If
Next j
Next i
' Loop backwards to find "Right End"
For k = 12 To 2 Step -1 '24 To 2
If Not IsEmpty(ws.Range("Cell_12")) Then
ws.Range("B82").Offset(12).Value = "Right End"
Exit For
' Has the "Right End" Follow when cars are left blank for lower row
ElseIf IsEmpty(ws.Range("Cell_" & k)) And Not IsEmpty(ws.Range("Cell_" & k - 1)) Then
ws.Range("B82").Offset(k - 1).Value = "Right End"
Exit For
End If
Next k
What I have here merely inserts a count into a cell range, what I'm trying to do is have my code actually read the cells in the range in the order I described and one at a time look at which cells have values written in them and look at which cells (with values in them) are to the right of any cell with a value and produce the table described above.
After reading your explanation, which was quite challenging I tried to recreate what you are asking.
I used cells A1:L1 with numbers 1 to 12. in the row below that A2:L2, some numbers have been added. with an if value <> "" you can see which cells contain a value.
In the second worksheet the table is made:
Sub test()
Dim a As Integer
Dim i As Integer
Dim name As String
ActiveWorkbook.Sheets(1).Activate
a = 1
For i = 1 To endcel
If Sheets(1).Range("a1").Offset(a, i - 1).Value <> "" Then
name = Sheets(1).Range("A1").Offset(a, i - 1).Value
Sheets(2).Activate
Sheets(2).Range("b2").Offset(i).Value = name
End If
Next i
End Sub
Does this help? You can adapt it a bit to your problem.
Good luck!
What I'm trying to achieve is there are 2 whole numbers in column A & B on the same row. I want to fill the row from Column C to show the whole numbers increments of one between the two numbers.
i.e.
A B C D E F G H I J K L
1 10 1 2 3 4 5 6 7 8 9 10
any help would be appreciated.
Assuming this is Excel and you can open the VBE Editor to use VBA
Here's a macro you can run or call via a button
See the comments in the code to understand what it's doing with the Dataseries fill function
Sub FillData()
Dim intStopAt As Integer
' Set to cell indicated low end of range
Cells(1, 1).Select
' Fill in "Start At" Number
ActiveCell.Offset(0, 2).Value = ActiveCell.Value
' Retrieve and use stop number to fill in series
intStopAt = ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(0, 2).DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=intStopAt
End Sub
The below code assumes you have no header and that your value in A1 is always 1, and your value in B1 is the number you want to count to.
This can be modified to be more dynamic, but taking your question as is, this should work for you.
1) Check number to count to (CountTo)
2) Run loop for 1 to CountTo and auto-populate your column headers
To run: Open VBE and paste this code on the sheet where you wish to run it.
Sub Counter()
Dim CountTo As Integer
CountTo = Range("B1").Value
For i = 1 To CountTo
Cells(1, i + 2) = i
Next i
End Sub
This can be done without VBA, perhaps not as neat initially as #dbmitch's answer because the formula has to go across to the maximum possible number.
A1 is start number, > 0
B1 is end number (> A1)
In Cell C1 enter =A1
In Cell D1 enter =IF(AND(C1<$B1,C1>=$A1),C1+1,"") and then
drag/fill right as far as you need to.
I have formulated the code so that you can now select the filled rows (A through to wherever) and fill down.
A simple explanation:
C1 sets the start of the list
The AND formula in D1 onwards checks that the immediate left cell (for D1 this is C1, for E1 this is D1 etc.) is less than the end number and greater than the start number.
If the conditions are true, use the immediate left cell value + 1 as the result.
If the conditions are false, insert a blank.
Further checking can be done, I have assumed in the above solution that the numbers are positive and increasing.
You can use helper columns to indicate if you should increase or decrease (i.e. +1 or -1 as required.
Using a blank as the other answer falls down if the numbers go from -ve to +ve. In this case, you could use another symbol (e.g. x) and check for that in the AND function as well.
you could use this:
Sub main()
Dim cell As Range
With Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers) ' reference column A cells from row 1 down to last not empty one with a "constant" (i.e. not a formula result) numeric content
For Each cell In .Cells 'loop through referenced range
cell.Offset(, 2).Resize(, cell.Offset(, 1).Value - cell.Value + 1).FormulaR1C1 = "=COLUMN()-COLUMN(C3)+RC1" 'write proper formula in current cell adjacent cells
Next
.CurrentRegion.Value = .CurrentRegion.Value ' get rid of formulas and leave values only
End With
End Sub
I am working on a macro to move data from one sheet to another based on matching cell values.
Let's say I have 2 sheets, Sheet1 & Sheet2, respectively.
Sheet1 contains data that I wanted to be copied into Sheet2.
Sheet2 contains a value in column "C", and this value with have multiple matches in column "C" of
Sheet1 (which are already sorted and same values are grouped together).
My overall goal is to copy cells from Sheet1 to Sheet2 based on matching values in column "C". I want to insert these values one row below the row with matching column "C" values.
The difficulty lies in the fact that the range of values copied from Sheet1 to Sheet2 will differ with each different value in Column "c" of Sheet2, because there will be a different number of rows with respect to a particular cell value.
(I would show a simple picture for this, but it won't allow me to post a picture due to low post count - I can email this if needed for clarification)
I am okay with basic macro stuff and rely on the Macro Record for some stuff as well. But with my current knowledge and lack of the macro recorder's ability to make a macro like this, I am just stumped!
My request:
Help with macro that selects a range of cells based on matching cell values to copy
Help with inserting the copied range starting 1 row below the cell value of interest (cell value is row 2, insert cells starting at row 3)
Have this repeated for each value listed in Sheet2
I think I can figure the basic coding with this. If I can just get help with the particular string that does what I am looking for would be great! I am not trying to just be handed the answer, but I have been working on this issue for 8+hrs and can't find anything online that is similar to this...
This code assumes that you have sorted the data as you have in the example:
Sub transfer()
'If everything is sorted, you can do it like this:
Dim x, y 'x is the sheet1 row, y is the sheet2 row
y = 2 'they start at the same place x = 2, y = 2
For x = 2 To Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
If Sheets(1).Cells(x, 1) = Sheets(2).Cells(y, 1) Then 'If the cell value matches
Sheets(1).Range("A" & x).Copy 'Copy the cell value from Sheet1
Sheets(2).Cells(y + 1, 1).Insert Shift:=xlDown 'And insert it below the Sheet2 Cell
'Then copy the rest of the data (columns C and D)
Sheets(1).Range("C" & x & ":D" & x).Copy Destination:=Sheets(2).Cells(y + 1, 2)
Else
x = x - 1 'We haven't found a match for this cell yet so check it again
End If
y = y + 1 'After incrementing y
Next x
End Sub
Sorry for slow reply - I can explain the code to you soon if need be!
Hope this helps! :)
I wrote this specifically for the example you gave me, so hopefully you are able to build upon this concept if your needs change.
I want to use an If statement (VBA code) to check the cell range in a column for a given numeric parameter. For the cell that matches the given value, the cells at the right (in the same row) should change the background color.
Pseudocode Example:
A1=5,7
If cell in Range(F1:F10) has value=A1 Then
(random matched cell: F7=5,7)
Range (G7:M7) = Background Blue
The part to change the background I know how to do it, but what is the best way to check the given range?
I think you want something like
for i = 1 to 10 'rows in column f to loop through
if cells(i,6) = cells(1,1) then 'column a is 1, column f is 6, etc.
range(cells(i,7), cells(i,13)).interior.colorindex = 'number for that color
end if
next i
I'm guessing you may have multiple rows in F1:F10 that have a match on A1. I would iterate through the cells in the range with:
For each rngCell in Range("F1:F10")
If rngCell.value = Range("A1").value
Range("G" & rngCell.row, "M" & rngCell.row).Interior.ColorIndex = 5
End If
Next
I have multiple spreadsheets that each roughly look like this:
I'm trying to find a way to go through each of the SPEAKER HEADERS in Row 1, and summarize the scores that are associated with the corresponding survey question ("Was the CONTENT good? Was the SPEAKER relevant? What the DELIVERY good?) grouped by color.
I can't think of a clever way of doing this automatically.
I can get the RANGE SPANS of the Merged Cells like this:
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
MsgBox Cell.MergeArea.Address
End If
Next
I then need to iterate over the range provided by the address, getting the numerical values in all the rows BELOW that range.
For example, running the current macro produces this:
I need to take $C$1:$E$1 and run a for loop that say FROM C1 to E1 average all the numbers in the rows below it. I have no idea how to do this.
I was thinking about augmenting the selection in include everything used
Is there a better way to do this?
This is the tragically bad way I'm doing it now (which I'm quite proud of on account of being new to excel):
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
Set rng = Range(Cell.MergeArea.Address) 'Equal to the Address of the Merged Area
startLetter = Mid(rng.Address, 2, 1) 'Gets letter from MergeArea Address
endLetter = Mid(rng.Address, 7, 1) 'Gets letter from MergeArea Address
On Error GoTo ErrHandler:
Set superRange = Range(startLetter & ":" & endLetter)
ErrHandler:
endLetter = startLetter
Set superRange = Range(startLetter & ":" & endLetter)
Resume Next
superRange.Select
MsgBox Application.Average(Selection)
In order to get rid of the error you are having, you need to change:
Set rng = Cell.MergeArea.Address
to
Set rng = Range(Cell.MergeArea.Address)
Ideally, this data would be better stored in a database so that it could be queried easily. If that's not an option, then the way you are going at it in Excel is as valid as most any other approach.
EDIT
Once you obtain the address of the left-most column for each of your speakers, you can loop through each column to obtain averages.
'Number of columns in the current speaker's range.
numColumns = rng.Columns.Count
'First row containing data.
currentRow = 4
'First column containing data.
firstColumn = rng.Column
'Loop through each column.
For col = firstColumn to firstColumn + (numColumns -1)
totalValue = 0
'Loop through each row.
Do While Cells(currentRow,col).value <> ""
totalValue = totalValue + Cells(currentRow,col).Value
currentRow = currentRow + 1
Loop
averageValue = totalValue / (currentRow - 3)
'Reset the currentRow value to the top of the data area.
currentRow = 4
'Do something with this average value before moving on to the next column.
Next
If you don't know what row is the start of your data, you can keep checking every row below rng.Row until you hit a numeric value.
The method above assumes that you have no blank entries in your data area. If you have blank entries, then you should either sort the data prior to running this code, or you would need to know how many rows you must check for data values.