I am new to macros in Excel, and I’m trying to speed up a process. I need to add a varying number of blank rows, if certain text is present in the cell above it. Not equal, but containing.
For example if A1 contains 'Apples', add two blank rows beneath. If A6 has 'Plums', add four blank rows beneath, etc.
What I have now is this:
For a=1 To ActiveSheet.Cells(Rows.Count,1).End(x1Up).Row
If ActiveSheet.Cells(a,1).Value = “Apples” Then
ActiveSheet.Rows(2).Insert
a = a+1
ELSE
If ActiveSheet.Cells(a,1).Value = “Plums” Then
ActiveSheet.Rows(4).Insert
a = a+1
End If
End Sub
So far I've gotten a Compile Error, stating "Block If without End If" though I believe I closed them both. I'm not sure if I'm correctly comparing or searching for a string as well (referring to my use of ="Apples"), but cannot get it to run at all to test that part.
For a = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If TypeName(ActiveSheet.Cells(a, 1)) = "String" Then
If ActiveSheet.Cells(a, 1).Value = "Apples" Then
ActiveSheet.Rows(2).Insert
a = a + 1
ElseIf ActiveSheet.Cells(a, 1).Value = "Plums" Then 'One error here
ActiveSheet.Rows(4).Insert
a = a + 1
End If
End If
Next 'And here too
Related
I am working with a VB macro. Essentially what I am trying to do is for the macros to read the input and first determine whether or not a cells ID number matches the one in the row. Example: If row 1 has an ID of 1122 and rows 2,3,4 and 5 all match, I want the macro to read that and create a count in the NbrOfA cell. Once it realizes that there is not an ID match it moves on to the next ID and looks for matches of that ID number and continues to create a count. While it is doing this, I also need it to read from another column that has specific strings such as "open", "closed" ect. read that input, and create a separate row titled NbrofOpenA. Once it runs out of data, I then want to have a singular cell that shows the number of actions (NbrOfA) that match the ID number as well as the number of open actions (NbrOfOpenA).
Currently I receive the error: “compile error: sub or function not defined” highlighting the Set Cell(Sheet2.Cells(FirstRowOfI, 23) = NbrOfA
Attached in the excel sheet attached it shows 2 cells deleted. They will not actually be deleted, just wanted to give an idea of what I was looking for
Sub ACount()
Dim FirstRowofI
Dim NbrOfA as Integer
Dim NbrOfOpenA as Integer
Row = 2
Set FirstRowofI = (Sheet2.Cells.Range(Row, 14))
NbrOfA = 0
NbrOfOpenA = 0
If (Sheet2.Cells(Row, 14).Value <> "") Then
NbrOfA = 1
If (Sheet2.Cells(Row, 22) <> "Closed") Then
NbrOfOpenA = 1
Set Row = FirstRowofI
Row = Row + 1
Do While (Sheet2.Cells(Row, 14) = (Sheet2.Cells(FirstRowofI, 14)))
NbrOfOpenA = NbrOfOpenA + 1
If (Sheet2.Cells(Row, 22) <> "Closed" Then
NbrOfOpenA = NbrOfOpenA + 1
Range(Row).EntireRow.Delete
Return
End If
Set Cell(Sheet2.Cells(FirstRowofI, 23)) = NbrOfA
Set Cell(Sheet2.Cells(FirstRowofI, 24)) = NbrOfOpenA
Loop
End Sub
[1
Do you need VBA? You can easily achieve what you're looking for with formulas, heck even a Pivot Table! Here's an example with formulas:
Hello I'm trying to delete all the rows where in column B the members value is over 1000.
I tried this step by step and tried first getting rid of all the unecessary data from B cells and leave just the line with the members.
I noticed there are 5 lines and the members line is the 6'th one. I searched for hours and I still don't get it HOW TO DELETE THE FIRST 5 LINES. Could you please offer me a hand of help? Im sure its soo easy but I cant find it.
I have this:
Option Explicit
Sub Delete5TextLines()
Dim c As Range, s
Application.ScreenUpdating = False
For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
**********
Next c
Application.ScreenUpdating = True
End Sub
this is the .csv file:
http://we.tl/vNcyfg9Wus
Alright, this is not very elegant, but the first thing that I came up with, that kinda works.
use this formula to delete the last word in your bulk of text ("members")
Assuming your text is in A1:
=LEFT(A1,FIND("|",SUBSTITUTE(A1," ","|",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))-1)
This formula gets you the last word of a text, in this case the number of members (because we deleted the word "members)
Assuming you put the formula above in A2
=IF(ISERR(FIND(" ",A2)),"",RIGHT(A2,LEN(A2)-FIND("*",SUBSTITUTE(A2," ","*",LEN(A2)-LEN(SUBSTITUTE(A2," ",""))))))
Now you should have extracted the number of members. If this value is <5000 you can delete the row with a vba loop that should look like this:
Sub deleteRowsAfterMembers
Dim i as Integer
i = ThisWorkbook.Sheets(1).Rows.Count
While i > 0 Do
If (CellWithMemberCount).Value < 5000 Then
ThisWorkbook.Sheets(1).Rows(i).Delete
End If
i = i-1
Loop
End Sub
That'll (hopefully) do it.
Whenever you delete entire rows using a loop, you should start at the bottom of the range and work the loop upwards.
EDIT#1:
Assuming that there are at least five lines within a cell and the lines are separated by Chr(10) then this will remove the first 5 lines:
Sub marine()
ary = Split(ActiveCell.Value, Chr(10))
t = ""
For i = 5 To UBound(ary)
t = t & Chr(10) & ary(i)
Next i
If Len(t) > 1 Then
t = Mid(t, 2)
Else
t = ""
End If
ActiveCell.Value = t
End Sub
I'm trying to get excel to put together a series of text strings that haven't been formatted systematically, so that they end up split into different rows on a data sheet.
I'm aware this might've been solved elsewhere so sorry for that but I'm struggling to describe the issue, and I can't post images on it but basically it's
Column 1 with a list of the entries, and
Column 2 with text strings that are spread over 2 or more rows
Is it possible to write some kind of formula or macro that would be able to check the first column and then stitch together all entries in the second column going down until it found a new entry in the first column? I've got a feeling it might be possible using some sort of loop thing with index functions, but I've no idea where to start even.
Thanks,
Mike
Mike give this a ty
Sub appendValues()
'The sub is designed to loop through code and when ever there is a null value and column a it will take the value of what is in column B and appended to the row above it and delete the row.
Dim row As Integer
row = 1
'This code starts with row one but this can be changed at will.
Do Until ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value = ""
'loop statement is designed to continue to Loop until there is a null value inside of you the value in the second column.
If ThisWorkbook.Sheets("sheet1").Cells(row, 1).Value = "" Then
ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value = ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value & ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value
Rows(row).Delete
Else
'else statement is needed because there is an implied looping by decreasing the total number of rows after the delete.
row = row + 1
End If
Loop
End Sub
Sub appendValues()
'The sub is designed to loop through code and when ever there is a null value and column a it will take the value of what is in column B and appended to the row above it and delete the row.
Dim row As Integer
row = 1
'This code starts with row one but this can be changed at will.
Do Until ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value = ""
'loop statement is designed to continue to Loop until there is a null value inside of you the value in the second column.
If ThisWorkbook.Sheets("sheet1").Cells(row, 1).Value = "" Then
ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value = ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value & ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value
Rows(row).Delete
Else
'else statement is needed because there is an implied looping by decreasing the total number of rows after the delete.
row = row + 1
End If
Loop
End Sub
I need to write a spreadsheet which when you press a button adds a row of data and asks for the parameters needed for the calculations, but I cant seem to get it to fill in the data in the next row down? I am a complete begginner to macros in excel and have only done very basic programming for matlab on my uni course.
My script so far is as follows:
Sub AddPosTol()
' AddPosTol Macro
Dim rngSeek As Range
Set rngSeek = Range("B1")
While rngSeek <> ""
'If the cell isn't empty, drop down one row:
rngSeek = rngSeek.Offset(1, 0)
End
With rngSeek.Offset(0, 1)
With .Font
.Name = "Solid Edge ANSI1 Symbols"
.Size = 11
.Value = 1
End With <--added this
End With
'don't need to call Range() around rngSeek - it is already a range type
rngSeek.Offset(0, 3) = "=RC[-1]"
rngSeek.Offset(0, 4) = "0"
With rngSeek.Offset(1, 1)
.Font.Bold = True <--don't really need a With if only one statement
End With
'can use a With statement here if you want:
With rngSeek
.Offset(1, 1) = "X value"
.Offset(2, 1) = "Y Value"
.Offset(0, 4) = "=2*SQRT((R[1]C[-3]-R[1]C)^2+(R[2]C[-3]-R[2]C)^2)"
.Offset(0, 5) = "=2*SQRT((R4C3-R[1]C)^2+(R5C3-R[2]C)^2)"
.Offset(0, 6) = "=2*SQRT((R[1]C[-3]-R[1]C)^2+(R[2]C[-3]-R[2]C)^2)"
.Offset(0, 7) = "=2*SQRT((R[1]C[-3]-R[1]C)^2+(R[2]C[-3]-R[2]C)^2)"
.Offset(0, 8) = "=2*SQRT((R4C3-R[1]C)^2+(R5C3-R[2]C)^2)"
.Offset(0, 2) = (InputBox("Insert Positional Tolerance Diametre"))
.Offset(1, 2) = (InputBox("Insert X value on drawing"))
.Offset(2, 2) = (InputBox("Insert Y value on drawing"))
End With
End Sub
OK, I'm going to refactor your code a bit to make it more readable, and try and answer your question too.
Firstly, I believe that lastrow = Worksheets("Sheet1").Rows.Count will return the number of rows in the worksheet, not the number of rows you have currently filled in. When I ran that line I got back 1048576! To find the first empty row, we need to find a column that will definitely have a value filled in for each row; then, cycle down that column looking for an empty cell: this is your first empty row:
Dim rngSeek as range
set rngSeek = Range("A1") <--your starting cell
While rngSeek <> ""
'If the cell isn't empty, drop down one row:
rngSeek = rngSeek.Offset(1, 0)
Wend
'rngSeek is now sitting at the first row that has a blank in column A
So this technique will find us the first row we are looking for. Then, we just populate that row with the data. You can leverage other elements from the code snippet above to make things easier when updating: specifically, the .offset method:
Your code:
With rngSeek.offset(0, 2)
With .Font
.Name = "Solid Edge ANSI1 Symbols"
.Size = 11
End With
.value = 1
End With
'repeat for all cells: no need to select them first, just use .offset
FYI .Offset goes like so:
Range("Cell Reference").Offset(rows, columns)
Where 'Cell Reference' can be any cell, like 'A1' or 'D24', rows is the number of rows to offset to the right (use negative number to offset to the left), and columns is the number of columns to offset down (use negative to offset up). So a value of .offset(0, 0) offsets to nowhere.
EDIT: You may not use column A to seek the first blank cell; if so, adapt the offset values to reflect which cell you want to change the value of. A value of 1 will offset one column right or one row down, and -1 will offset one column left or one row up.
ADDITION: It will be better to use Range("A1").End(xlDown) instead of the loop to find the first blank cell. Set the range variable equal to this, and replace the loop with:
set rngSeek = Range("A1").End(xlDown).Offset(1, 0)
You can then use rngSeek the way described above. (you can rename rngSeek to any variable name also).
I'm am relatively familiar with Excel and its functions, but am very new to VBA (I do however have background in MATLAB and C). Basically what I have is a sheet with a different machine populating each column header and a name of an employee populating the first column. The table contains text values of either "Train", indicating that the person in that row is trained on the equipment in the specified column, or "No", indicating that they are not. What I want to do is to make a separate sheet that has the Equipment in the first column and one column headered as "Trained". Each cell will theoretically be populated with the names of the people who are trained on the equipment for that row. I have a for loop code in VBA that successfully outputs the names into the immediate window
Function Train(Data As Range, Name As Range)
For Counter = 1 To Data.Rows.Count
If Data(Counter, 1).Value = "Train" Then
'Debug.Print Name(Counter, 1)
End If
Next Counter
End Function
but I have been unable in a few hours of searching to figure out how to display these values in a single cell. Is this possible?
Thanks in advance!
You have to choose if you want to do "For each person, for each machine", or "for each machine, for each person" first. Let say you want to go with the second idea, you could go with this pseudo code:
set wsEmployee = Worksheets("EmployeeSheet")
set wsEmployee = Worksheets("MachineSheet")
'Clear MachineSheet and add headers here
xEmployee = 2
yMachine = 2
do while (wsEmployee.Cells(1, xEmployee).Value <> "") 'or your loop way here
yEmployee = 2
trained = ""
do while (wsEmployee.Cells(yEmployee, 1).Value <> "") 'or your loop way here
if (wsEmployee.Cells(yEmployee, xEmployee).Value = "Trained") then
trained = trained & wsEmployee.Cells(yEmployee, 1).Value & ", "
end if
yEmployee = yEmployee + 1
loop
'remove the last , in the trained string
wsMachine.Cells(yMachine, 1).Value = wsEmployee.Cells(1, xEmployee).Value
wsMachine.Cells(yMachine, 2).Value = trained
yMachine = yMachine + 1
xEmployee = xEmployee + 1
loop
That's the basic idea. For better performances, I would do all these operation in some arrays and paste them in one operation.
Use the concatenation operator (&) to assemble the values into a string:
Dim names as String
names = ""
For Counter = 1 To Data.Rows.Count
If Data(Counter, 1).Value = "Train" Then
If counter = 1 Then
names = names & Name(counter, 1)
Else
names = names & "," & Name(counter, 1)
End If
End If
Next Counter
Then just place names in whatever cell you want.