Good day!
I am currently having a slight issue with a command button, which, I would like to be able to do the following: format a specific row to a certain row height, add thick borders to a certain number of cells in this same row and counting and adding the number of rows thus produced to the initial number in the file. Basically, the button should enable the user of the spread sheet to add a new row with specific formatting into which the user will input data and keep track of the number of rows added.
My current code stands as is:
Option Explicit
Private Sub NewLineRedButton_Click()
Dim i As Long
Dim y As Long
For y = ThisWorkbook.Worksheets("Flags").Cells(16.3) To y + 1
ThisWorkbook.Worksheets("Flags").Cells(16, 3) = y + 1
For i = 20 To i + y Step 1
ThisWorkbook.Worksheets("Flags").Rows(i).RowHeight = 45
ThisWorkbook.Worksheets("Flags").Cells(i, 1).Borders.LineStyle = xlContinuous
ThisWorkbook.Worksheets("Flags").Cells(i, 1).Borders.Weight = xlMedium
Next
Next
End Sub
At the moment the code executes only for two rows below and stops. I am not quite sure, why...?
Writing a for loop like this
For y = ThisWorkbook.Worksheets("Flags").Cells(16.3) To y + 1
is the same as writing it like this
For y = ThisWorkbook.Worksheets("Flags").Cells(16.3) To 1
I'm guessing the value in the cell is zero so it will execute the loop for 0 and 1 - i.e. the two times you are seeing.
You need something like
lEndRow = lStartRow + (lRowCount - 1)
For y = lStartRow to lEndRow
I have this going fine now. Just can't get it to do all the columns with the right borders... I am not sure how to to call them while using the cells(#, #) notation and I can't see how to use the Range(''Z#,Z#'') notation with my i variable being a Long...
Anyways: here's the result so far:
Option Explicit
Private Sub NewLineRedButton_Click()
Dim i As Long
Dim y As Long
Dim RowEnd As Long
RowEnd = ThisWorkbook.Worksheets("Flags").Cells(Rows.Count, 1).End(xlUp).Row
For y = 19 To RowEnd
ThisWorkbook.Worksheets("Flags").Cells(16, 3) = y - 17 ' First row which is already on the sheet is on row 19, first row appearing by button clicking is on row 20 and the program is counting the header hence the y - 17 for the value of the number of rows.
For i = 19 To RowEnd + 1 Step 1
ThisWorkbook.Worksheets("Flags").Rows(i).RowHeight = 45
ThisWorkbook.Worksheets("Flags").Cells(i, 1).Borders.LineStyle = xlContinuous
ThisWorkbook.Worksheets("Flags").Cells(i, 1).Borders.Weight = xlMedium
Next
Next
End Sub
Thanks for the help and ideas, finally wiggled around and found other resources from the leads given here.
Related
How do i write the following code as a loop. I want to copy values from a table in sheet 4 in a row from range (b:17:L17"). is there a more efficient way to do it with loops ?
ActiveSheet.Range("B17").Value = Sheets(4).Range("G8")
ActiveSheet.Range("C17").Value = Sheets(4).Range("G9")
ActiveSheet.Range("D17").Value = Sheets(4).Range("G10")
ActiveSheet.Range("E17").Value = Sheets(4).Range("G11")
ActiveSheet.Range("F17").Value = Sheets(4).Range("G12")
ActiveSheet.Range("G17").Value = Sheets(4).Range("G13")
ActiveSheet.Range("H17").Value = Sheets(4).Range("G14")
ActiveSheet.Range("I17").Value = Sheets(4).Range("G15")
ActiveSheet.Range("J17").Value = Sheets(4).Range("G16")
ActiveSheet.Range("K17").Value = Sheets(4).Range("G17")
ActiveSheet.Range("L17").Value = Sheets(4).Range("G18")
Yes, there is:
ActiveSheet.Range("B17:L17").Value = Application.Transpose(Sheets(4).Range("G8:G18").Value)
You can, using something like this (VB.Net, but may copy easily to VBA):
Dim cell as Integer, c as Integer
cell = 8
For c = 66 To 76
ActiveSheet.Range(Chr(c) & "17").Value = Sheets(4).Range("G" & cell)
cell = cell + 1
Next
The Chr() function gets the character associated with the character code (66-76), and then this value is concatenated with the string "17" to form a complete cell name ("B17", "C17", ...)
I am also incrementing the cell number for G at the same time.
Use this if you really want to use a loop - but there could be better ways, like the answer given by #A.S.H
Solution explanation:
Establish your rules! What is changing in the range for active sheet? The column is going to grow as the for/to cycle does! So, we should sum that to it. What is the another thing that is going to increment? The Range in the other side of the '=' so, by setting an algorithm, we may say that the row is const in the Activesheet range and the column is the on variable on the other side.
Solution:
Sub Test()
Const TotalInteractions As Long = 11
Dim CounterInteractions As Long
For CounterInteractions = 1 To TotalInteractions
'where 1 is column A so when it starts the cycle would be B,C and so on
'where 7 is the row to start so when it begins it would became 8,9 and so on for column G
ActiveSheet.Cells(17, 1 + CounterInteractions).Value = Sheets(4).Cells(7 + CounterInteractions, 7)
Next CounterInteractions
End Sub
This is probably your most efficient solution in a with statement:
Sub LoopExample()
Sheets("Sheet4").Range("G8:G18").Copy
Sheets("Sheet2").Range("B17").PasteSpecial xlPasteValues, Transpose:=True
End Sub
I'm creating a sales channel map and use the .Left/.Top w/ + (.5*.width/.Height) to get the center of the images I'm connecting. I'd like to also use this method to select the cell that corresponds to this coordinate.
The only solution I can think of (and could implement, but I'd rather avoid an iterative approach) would be something like:
Sub FindCellLoc(DesiredYLocation,DesiredXLocation)
'Finds the Column Number of the X coordinate
RunningTotalX = 0
For X = 1 to 100000000
RunningTotalX = RunningTotalX + Cells(1,X).width
if RunningTotalX >= DesiredXLocation then
TargetCol = Cells(1,X).Column
Goto FoundCol
End if
Next X
FoundCol:
'Finds the Column Number of the X coordinate
RunningTotalY = 0
For Y = 1 to 100000000
RunningTotalY = RunningTotalY + Cells(Y,1).width
if RunningTotalY >= DesiredYLocation then
TargetRow = Cells(Y,0).Column
Goto FoundRow
End if
Next Y
FoundRow
Cells(TargetRow,TargetCol).Select
End Sub
I'd really appreciate any input about a non-iterative approach.
Thanks,
-E
Here is a routine to select a cell based on the x and y position:
Public Sub SelectCellByPos(x, y)
With ActiveSheet.Shapes.AddLine(x, y, x, y)
.TopLeftCell.Select
.Delete
End With
End Sub
I assume you have access to the shape object from which you got the desired locations. If so, you could do something like
Function GetCenterCell(shp As Shape) As Range
Dim lRow As Long, lCol As Long
lRow = (shp.TopLeftCell.Row + shp.BottomRightCell.Row) \ 2
lCol = (shp.TopLeftCell.Column + shp.BottomRightCell.Column) \ 2
Set GetCenterCell = shp.Parent.Cells(lRow, lCol)
End Function
Sub test()
Dim shp As Shape
Set shp = Sheet1.Shapes(1)
Debug.Print GetCenterCell(shp).Address
End Sub
That won't give you the exact middle if there isn't an exact middle. It will skew top and left as the integer division truncates (I think). But using the TopLeftCell and BottomLeftCell properties will be far superior to iterating, even if it means you're iterating through the cells in that range or some other implementation.
I have code that is designed to loop through each cell in a row and delete them EXCEPT for the A and O columns. When I run this code it only deletes the second column.
I am aware of the "Rows(Target.Row).ClearContents" line but this does not suit my purposes as I need specific columns to stay intact.
Dim i As Integer
For i = 2 To i = 30
If i = 15 Then
'update i but do nothing
i = i + 1
Else
'update i and clear contents of cell
.Cells(Target.Row, i).Clear
i = i + 1
End If
Next
The For loop increments the i so you shouldn't, and this syntax is incorrect For i = 2 To i = 30:
Dim i As Long
For i = 2 To 30
If i <> 15 Then .Cells(Target.Row, i).Clear
Next
A faster way to exclude certain columns from the row (without using a loop):
With Target.Parent
.Columns(15).Hidden = True
.UsedRange.Rows(Target.Row).SpecialCells(xlCellTypeVisible).Clear
.Columns(15).Hidden = False
End With
Why use loops at all?
Union(Range(.Cells(Target.Row,2),.Cells(Target.Row,14)), Range(.Cells(Target.Row,16),.Cells(Target.Row,30))).Clear
I'm trying to delete rows on one worksheet based on a range in another worksheet. I think the problem here is probably something simple based on my limited VBA experience. Here is the code I've written:
Sub LimitedElements()
imax = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To imax
If Sheets("test").Cells(j, 1).Value = Sheets("Limited Elements").Range("A1:A10") Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub
I get a message saying "Application-defined or object-defined error".
Can anyone tell me what I'm doing wrong? Or if this is just a dumb way to do this and I should be doing it differently?
Please see if below works for you:
Sub LimitedElements()
Dim imax As Integer
Dim a As Variant
Dim b As Range
Dim c As Object
Dim d As Integer
imax = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To imax
a = Sheets("test").Cells(i, 1).Value
Set b = Sheets("Limited Elements").Range("A1:A10")
Set c = b.Find(What:=a, LookIn:=xlValues)
If Not c Is Nothing Then
Sheets("test").Rows(i).EntireRow.Delete
i = i - 1
imax = imax - 1
End If
Next i
End Sub
Noted that it is not fine tuned and is intended to give you an understanding on how to approach the solution.
I added code to decrement i. I think I understand that the code can't tell which worksheet I'm specifying for deleting the row but I'm not sure what to do about it. I tried changing "Rows(i).EntireRow.Delete" to "Sheets("test").Rows(i).EntireRow.Delete" but I'm not sure if that's the right thing to do or not.
Some extra details to make things clearer:
Sheet "test" has about 1000 rows with unique numbers in column A. Sheet "Limited Elements" has about 100 rows with unique numbers column A. I want it it delete the rows in "test" that have values in column A that match the column A values in "Limited Elements".
Sub LimitedElements()
imax = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To imax
If Sheets("test").Cells(i, 1).Value = Sheets("Limited Elements").Range("A1:A10") Then
Sheets("test").Rows(i).EntireRow.Delete
i = i - 1
imax = imax - 1
End If
Next i
End Sub
I think the original problem was that I had Cells(j,1) instead of cells(i,1). Now I've fixed that but it gives me a type mismatch error which I think is due to comparing a single cell to a range.
At this point I think I'm just lost. I can't figure out how to change it so it works and does what I want it to do.
I have been trying to get this VBA script to work to automate a task, but I cannot get it to work.
Basically, I have a big task list in excel with multiple columns and over 1000 Rows. It contains the task, who it is assigned to, and if it is open or closed.
In column H is who it assigned to and column N is whether the task is opened or closed.
I am trying to search by last name and if it is OPEN to add one to the counter. The end goal is to get a total count of how many open tasks a person has. Also, some of the cells in column N (task status) has extra text like comments, etc. I am sure that a InStr Function to search for the one word within the Cell would work better, but I cannot figure it out...
here is my code
Sub statuscount()
Dim tasksheet As Worksheet
Dim simons_count As Integer
Set tasksheet = ThisWorkbook.Sheets("tasks")
lr = tasksheet.Cells(Rows.Count, 1).End(xlUp).Row
For x = 5 to lr
If tasksheet.Cells(x, 8) = "Simons" And tasksheet.Cells(x, 14) = "OPEN" Then
simons_count = simons_count + 1
End If
Next x
tasksheet.Range("$O$5").Value = simons_count
End Sub
Thanks for the help!
Using If/And gets tricky in VBA, you're better off nesting two if statements:
For x = 5 to lr
If tasksheet.Cells(x, 8) = "Simons" Then
If InStr(tasksheet.Cells(x, 14).Value, "OPEN") > 0 Then
simons_count = simons_count + 1
End If
End If
Next x
This is a more general function. Insert a module and past the below code in it. Than you can use the function just like any other Excel built-in function
Function LastNamecounter(lastName As String, status As String) As Long
LastNamecounter = 0
Dim tasksheet As Worksheet
Set tasksheet = ThisWorkbook.Sheets("tasks")
lr = tasksheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To lr
If InStr(tasksheet.Cells(i, 8).Value, lastName) <> 0 And InStr(tasksheet.Cells(i, 14).Value, status) <> 0 Then
LastNamecounter = LastNamecounter + 1
End If
Next i
End Function