I have the following code,
Sub AddZeroes()
'Declarations
Dim i As Integer, j As Integer, endrow As Long
'Converts the A column format to Text format
Application.ScreenUpdating = False
Columns("A:A").Select
Selection.NumberFormat = "#"
'finds the bottom most row
endrow = ActiveSheet.Range("A1").End(xlDown).Row
'selects the top cell in column A
ActiveSheet.Range("A1").Select
'loop to move from cell to cell
For i = 1 To endrow - 1
'Moves the cell down 1. Assumes there's a header row so really starts at row 2
ActiveCell.Offset(1, 0).Select
'The Do-While loop keeps adding zeroes to the front of the cell value until it hits a length of 7
Do While Len(ActiveCell.Value) < 7
ActiveCell.Value = "0" & ActiveCell.Value
Loop
Next i
Application.ScreenUpdating = True
End Sub
And it adds preceding zeroes to numbers and converts them to text to make them 7 charecters long if they are less than 7. ANd it has been working all day and suddenly it has stopped. I Keep getting the error RUN TIME ERROR 6 OVERFLOW. I am at a loss because it has worked without any issues all day up until now. It keeps highlighting the portion:
For i = 1 To endrow - 1
Any thoughts?
Change this line:
Dim i As Integer, j As Integer, endrow As Long
To be this instead:
Dim i As Long, j As Long, endrow As Long
Integer variables can only go up to 32,767. If your row numbers are higher than that, you need to use Long.
Related
I am using dijkstra algorithm for VRP , so it works like this
i am giving an random input between node numbers (1,2,3,..) and after that input it takes it as i and starting to searching for minimum value in i. row and finding the minimum value at j. column so next step j becomes my next row and i am trying to iterate as like that
so i need to find minimum value of row's in for loop i tried to giving
application.worksheet.function.min(range)
For i = Sheets("sayfa1").Cells(15, 1) To Sheets("sayfa1").Cells(15, 1) + 1
For j = i + 1 To 11
if cell(i,j) = application.WorksheetFunction.Min(range of row) then
cell.clearcontents
end if
i = j
nextj
but range always changing by row so it doesn't work
It is not very clear to me what you need to determine exactly. As far as I have understood, I have quickly written a macro for your question. Hope it solves your problem or at least helps you to get to the solution. You could try something like this:
Sub Min_values_loop()
Dim ws1 As Worksheet
Dim FirstCol As Long, LastCol As Long, FirstRow As Long, LastRow, MinValue As Long
'set sheet name
Set ws1 = Worksheets("sayfa1")
'set your frist and last column and row numbers here
FirstCol = 1
LastCol = 3
FirstRow = 1
LastRow = 10
'loop through columns
For i = FirstCol To LastCol
MinValue = Application.WorksheetFunction.Min(ws1.Range(Cells(FirstRow, i), Cells(LastRow, i)))
MsgBox "The minimum value in the range is " & MinValue
Next i
End Sub
You can change the first and last row number or the column numbers as per your requirement.
I haven't been able to find an answer to what a single number represents here. I'm trying to find the row where the last occurrence of a string occurs, copy that entire row, and insert it below that row. To try and get the first part, where I can find the row value of the last occurrence, what does this "3" represent?
Dim shortname As String
Dim endRow As Integer
Dim lastRowSearchValue As Range
shortname = "CATS"
With ActiveSheet
endRow = .Cells(Rows.Count, 33).End(xlUp).Row
For i = 1 To endRow
If .Cells(i, 33) = shortname Then
lastRowSearchValue = i
End If
Next i
End With
lastRowSearchValue.Copy
Cells(Row,Column)
So it is the Column number.
See: https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.cells
So .Cells(Rows.Count, 33).End(xlUp).Row is starting at the bottom of Column 33 and and searching up till it finds the first cell from the bottom that has a value.
Then the loop is looping from the first Row to that last row and checking the value in that column on each row.
If .Cells(i, 33) = shortname Then is then checking that cell, each one in that column if its value is the same as shortname
but this is probably an x/y problem as lastRowSearchValue = i does not return a range but a long:
You want:
Set lastRowSearchValue = .Cells(i,33)
I assume you need cell rather row number. Anyway, the following code tries to find this cell:
Sub FFF()
Dim cell As Range, lastRowSearchValue&
Set cell = Columns(33).Find(What:="CATS", LookAt:=xlWhole, SearchDirection:=xlPrevious)
If Not cell Is Nothing Then
lastRowSearchValue = cell.Row
Else
MsgBox "No value found", vbExclamation
End If
End Sub
Correcting Code
endRow has to be declared as long because .Rows.Count exceeds the limit for Integer.
33 is the column number, or Column AG. Your code searches for CATS in column AG starting from row 1 to the last row with data and when found it assigns the found row number to lastRowSearchValue which is incorrect because lastRowSearchValue is a range. Correct would be Set lastRowSearchValue = .Cells(i, 33) to be able to continue with lastRowSearchValue.Copy. It will continue searching until the end to find other occurrences of CATS. To stop this you can add the line Exit For to exit the loop when CATS was found. But since you do want to find the last occurrence, you don't wanna do that.
I've chosen to declare lastRow as Long to get the last occurring row and then copy that row one row below. To make it less confusing, I have used the column letters.
The Code
Sub CopyRowBelowWhenFound()
Dim shortname As String
Dim endRow As Long
Dim lastRow As Long
Dim i As Integer
shortname = "CATS"
With ActiveSheet
endRow = .Cells(.Rows.Count, "AG").End(xlUp).Row
For i = 1 To endRow
If .Cells(i, "AG") = shortname Then
lastRow = i
End If
Next i
With .Cells(lastRow, "AG")
.EntireRow.Copy .Offset(1, 0).EntireRow
End With
End With
End Sub
Here's my problem: I want to bold entire rows of my spreadsheet IF the value of one of the columns equals either 'Saturday' or 'Sunday'. I've found ways to bold the cells, but not the entire row. Can someone please help?
Oh, I would also like to increase the font, from 10 to 12, based on same condition.
Thanks!
So ... I got a bit bored and made this for you
Sub Test()
Dim cRow as Long
Dim rRow As Range
Dim LastRow As Long
'Gets the last row with data in it
LastRow = [A65000].End(xlUp).Row
'the look to move down the cells
For cRow = 1 To LastRow
'if statment so catch the values that are wanted
If Cells(cRow, 1) = "Saturday" Or Cells(cRow, 1) = "Sunday" Then
'the changes made to the rows
Rows(cRow).Font.Bold = True
Rows(cRow).Font.Size = 12
End If
Next cRow
End Sub
Brief explincation, the LastRow gets the last row in column A (this is needed so we dont go past any of the data we need and intoblank cells (Change the column letter to which ever column you need))
The loop For cRow = 1 To LastRow (the cRow will +1 for each Next cRow) will count down the cells till it reachs the LastRow
The If Cells(cRow, 1) = "Saturday" Or Cells(cRow, 1) = "Sunday" Then will check the cell and if it has the value in the cell it will then change it to bold and size 12 font
If there is anything you are unclear of in the code let me know and I will try to clarify
Private TurnRowToBold()
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lLastRow
If (Worksheets("MySheet").Cells(i, 1) = "Saturday" or Worksheets("MySheet").Cells(i, 1) = "Sunday") Then
Worksheets("MySheet").Rows(i).Font.Bold = True
Worksheets("MySheet").Rows(i).Font.Size = 12
End If
Next
End Sub
I have the following macro that adds 0s to ID numbers until they are 7 numbers long. I have used it countless times before and it has always worked without fail until today it started not working and the portion of the code For i = 1 To endrow - 1 is highlighted every time and I cannot debug the issue. The whole code is.
Sub AddZeroes()
'Declarations
Dim i As Integer, j As Integer, endrow As Long
'Converts the A column format to Text format
Application.ScreenUpdating = False
Columns("A:A").Select
Selection.NumberFormat = "#"
'finds the bottom most row
endrow = ActiveSheet.Range("A1").End(xlDown).Row
'selects the top cell in column A
ActiveSheet.Range("A1").Select
'loop to move from cell to cell
For i = 1 To endrow - 1
'Moves the cell down 1. Assumes there's a header row so really starts at row 2
ActiveCell.Offset(1, 0).Select
'The Do-While loop keeps adding zeroes to the front of the cell value until it hits a length of 7
Do While Len(ActiveCell.Value) < 7
ActiveCell.Value = "0" & ActiveCell.Value
Loop
Next i
Application.ScreenUpdating = True
End Sub
Not sure what is causing the error - but would suggest another approach:
sub addZeros()
Application.ScreenUpdating = False
' start at row 2 since OP said there's a header row
Dim c as Range
for each c in Range("A2", [A2].End(xlDown))
c.Value = "'" & Format(c.Value, "00000000")
next c
Application.ScreenUpdating = True
end sub
A bit more compact...
Note that I'm adding the "'" apostrophe to make Excel treat the cell value as string. This is a safe way to make sure the zeros stay...
EDIT: Got rid of the last .Select to show it can be done, and is generally good practice as pointed out in comments.
I have an excel file which looks like this:
row1_cell1 row1_cell2 row1_cell3
row2_cell1 row2_cell2 row2_cell3
row3_cell1 row3_cell2 row3_cell3
How can i make three (or any number of) copies of each row that i have in the sheet, which i would like to be added after the row being copied? So, in the end i would like to have this kind of a result:
row1_cell1 row1_cell2 row1_cell3
row1_cell1 row1_cell2 row1_cell3
row1_cell1 row1_cell2 row1_cell3
row2_cell1 row2_cell2 row2_cell3
row2_cell1 row2_cell2 row2_cell3
row2_cell1 row2_cell2 row2_cell3
row3_cell1 row3_cell2 row3_cell3
row3_cell1 row3_cell2 row3_cell3
row3_cell1 row3_cell2 row3_cell3
This is how I would do that for all rows on the sheet:
Option Explicit
Sub MultiplyRows()
Dim RwsCnt As Long, LR As Long, InsRw As Long
RwsCnt = Application.InputBox("How many copies of each row should be inserted?", "Insert Count", 2, Type:=1)
If RwsCnt = 0 Then Exit Sub
LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For InsRw = LR To 1 Step -1
Rows(InsRw).Copy
Rows(InsRw + 1).Resize(RwsCnt).Insert xlShiftDown
Next InsRw
Application.ScreenUpdating = True
End Sub
There isn't a direct way to paste them interleaved like what you wanted. However, you can create a temporary VBA to do what you want.
For example, you can:-
Create a VBA procedure (like the one below) in your Excel file.
Assign a keyboard shortcut (eg. Ctrl+Q) to it.
To do this, press Alt+F8, then select the macro, then click 'Options'.
Select the cells you want to copy, then press Ctrl+C.
Select the cell you want to paste in, then press Ctrl+Q (or whatever keyboard shortcut you chose).
Enter the number of times you want to copy. (In your example, it would be 3.)
WHAMMO! :D
Now you can delete the VBA procedure. :)
VBA Code:
Sub PasteAsInterleave()
Dim startCell As Range
Dim endCell As Range
Dim firstRow As Range
Dim pasteCount As Long
Dim rowCount As Long
Dim colCount As Long
Dim i As Long
Dim j As Long
Dim inputValue As String
If Application.CutCopyMode = False Then Exit Sub
'Get number of times to copy.
inputValue = InputBox("Enter number of times to paste interleaved:", _
"Paste Interleave", "")
If inputValue = "" Then Exit Sub 'Cancelled by user.
On Error GoTo Error
pasteCount = CInt(inputValue)
If pasteCount <= 0 Then Exit Sub
On Error GoTo 0
'Paste first set.
ActiveSheet.Paste
If pasteCount = 1 Then Exit Sub
'Get pasted data information.
Set startCell = Selection.Cells(1)
Set endCell = Selection.Cells(Selection.Cells.count)
rowCount = endCell.Row - startCell.Row + 1
colCount = endCell.Column - startCell.Column + 1
Set firstRow = Range(startCell, startCell.Offset(0, colCount - 1))
'Paste everything else while rearranging rows.
For i = rowCount To 1 Step -1
firstRow.Offset(i - 1, 0).Copy
For j = 1 To pasteCount
startCell.Offset(pasteCount * i - j, 0).PasteSpecial
Next j
Next i
'Select the pasted cells.
Application.CutCopyMode = False
Range(startCell, startCell.Offset(rowCount * pasteCount - 1, colCount - 1)).Select
Exit Sub
Error:
MsgBox "Invalid number."
End Sub
Old thread, however someone might find this useful:
The below information was copied from here
I needed to do almost the opposite. I needed the formula to increment by 1 every 22 rows, leaving the 21 rows between blank. I used a modification of the formula above and it worked great. Here is what I used:
=IFERROR(INDIRECT("J"&((ROW()-1)*1/22)+1),"")
The information was in column "J".
The "IFERROR" portion handles the error received when the resulting row calculation is not an integer and puts a blank in that cell.
Hope someone finds this useful. I have been looking for this solution for a while, but today I really needed it.
Thanks.