I want to write macro which sets cells in worksheets "Section_errors" and "Elemant_errors" is equal to cells in "ICS Analysis" worksheet. All data exists in "ICS Analysis" . I try the code below, but it doesnot work and any error doesnot appear. What can be a reason? I tryied also simple copy-paste, it operates, but it takes too much time
Sub copy_id()
Dim i As Integer
Dim lastrow As Integer
lastrow = Worksheets("ICS Analysis").Cells(Worksheets("ICS Analysis").Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
Worksheets("Element_errors").Cells(i, 73).Value = Worksheets("ICS Analysis").Cells(i, 3).Value
Worksheets("Section_errors").Cells(i, 10).Value = Worksheets("ICS Analysis").Cells(i, 3).Value
Next i
End Sub
The solution according to me is:
Sub copy_id()
Dim i As Integer
Dim lastrow As Integer
lastrow = Worksheets("ICS Analysis").Cells(Worksheets("ICS Analysis").Rows.Count,1).End(xlUp).Row
For i = 1 To lastrow
Worksheets("Element_errors").Cells(i, 73).Value = Worksheets("ICS Analysis").Cells(i,3).Value
Worksheets("Section_errors").Cells(i, 10).Value = Worksheets("ICS Analysis").Cells(i,3).Value
Next i
End Sub
The change is the location of the definition of the variable lastrow.
You see, in the earlier version, the lastrow was getting a value 1 before entering the loop and thus the loop was not running.
Hence no data.
Hope this helps...
Related
I'm trying to create excel template (the volume of data will be different from case to case) and it looks like this:
In every even row is "Customer" and I would like to put in every odd row "Ledger". Basically it should put "Ledger" to every odd row until there are data in column C. I have this code:
'========================================================================
' INSERTING LEDGERS for every odd row (below Customer)
'========================================================================
Sub Ledgers()
Dim rng As Range
Dim r As Range
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C5:C" & LastRow)
For i = 1 To rng.Rows.Count
Set r = rng.Cells(i, -2)
If i Mod 2 = 1 Then
r.Value = "Ledger"
End If
Next i
End Sub
But it gives me an error msg Invalid or unqualified reference. Could you advise me, where I have the error, please?
Many thanks!
If a command starts with . like .Cells it expects to be within a with statement like …
With Worksheets("MySheetName")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C5:C" & LastRow)
End With
So you need to specify the name of a worksheet where the cells are expected to be in.
Not that it would be a good idea to use Option Explicit at the top of your module to force that every variable is declared (you missed to declare i As Long).
Your code could be reduced to …
Option Explicit
Public Sub Ledgers()
Dim LastRow As Long
Dim i As Long
With Worksheets("MySheetName")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
'make sure i starts with a odd number
'here we start at row 5 and loop to the last row
'step 2 makes it overstep the even numbers if you start with an odd i
'so there is no need to proof for even/odd
For i = 5 To LastRow Step 2
.Cells(i, "A") = "Ledger" 'In column A
'^ this references the worksheet of the with-statement because it starts with a `.`
Next i
End With
End Sub
Just loop with a step 2 to get every other row in your indexer variable.
Sub Ledgers()
Dim rng As Range
Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
Set rng = ActiveSheet.Range("C5:C" & LastRow)
For i = 1 To LastRow step 2
rng.Cells(i, 1) = "Ledger" 'In column A
Next i
End Sub
I am attempting to use VBA to fill all blank cells in rows with the value to the left, with the exception that I only want to fill the blank cells between the first and last value in the row (not including row 1 and column A, which are identifiers).
I've struggled with getting the loop to stop once the last column with a value has been reached (as this changes with each row), rather than running all the way through the last column on the sheet.
Originally this was marked as duplicate (Autofill when there are blank values), but this does not solve the mentioned problem. This continues until the sheet ends. As seen in the picture below, the fill should stop when the last value is reached.
I am searching for a solution that will allow me to do this for an entire sheet at once, even though the data ends in different columns throughout the sheet. There are 1000+ rows, so running for each row could be quite tedious.
I've been using this code to fill the data (excluding the 1st row and column). But this is where I am not sure how to get it to stop at the last value in the row.
Sub test()
With ThisWorkbook.Sheets("Sheet1").Range("A:A")
With Range(.Cells(2, 2), .Cells(.Rows.Count, 36).End(xlUp))
With .Offset(0, 1)
.Value = .Value
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]&"""""
On Error GoTo 0
.Value = .Value
End With
End With
End With
End Sub
If my explanation was not clear, This is a sample and the output I am trying to create
Thank you all so much in advance for all your help!
You may try something like this...
Sub FillBlanks()
Dim r As Long, lr As Long, lc As Long
Dim cell As Range, FirstCell As Range, LastCell As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(2, Columns.Count).End(xlToLeft).Column
For r = 3 To lr
Set FirstCell = Range(Cells(r, 1), Cells(r, lc)).Find(what:="*", after:=Cells(r, 1))
If Not FirstCell Is Nothing And FirstCell.Column > 1 Then
Set LastCell = Cells(r, Columns.Count).End(xlToLeft)
Range(FirstCell, LastCell).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
Range(FirstCell, LastCell).Value = Range(FirstCell, LastCell).Value
End If
Next r
End Sub
And here is yet another solution (just to give you some variety):
Option Explicit
Sub fillInTheBlanks()
Dim lngRow As Long
Dim ws As Worksheet
Dim lngColumn As Long
Dim bolStart As Boolean
Dim lngLastColumn As Long
Dim dblTempValue As Double
Dim arrSheetCopy As Variant
Set ws = ThisWorkbook.Worksheets("Sheet1")
arrSheetCopy = ws.Range(ws.Cells(3, 1), ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row, ws.UsedRange.Columns.Count)).Value2
For lngRow = LBound(arrSheetCopy, 1) To UBound(arrSheetCopy, 1)
bolStart = False
lngLastColumn = 0
For lngColumn = LBound(arrSheetCopy, 2) To UBound(arrSheetCopy, 2)
If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty Then lngLastColumn = lngColumn
Next lngColumn
For lngColumn = LBound(arrSheetCopy, 2) To lngLastColumn
If arrSheetCopy(lngRow, lngColumn) = vbEmpty And bolStart Then
arrSheetCopy(lngRow, lngColumn) = dblTempValue
Else
If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty And IsNumeric(arrSheetCopy(lngRow, lngColumn)) Then
bolStart = True
dblTempValue = CDbl(arrSheetCopy(lngRow, lngColumn))
End If
End If
Next lngColumn
Next lngRow
ws.Range("A3").Resize(UBound(arrSheetCopy, 1), UBound(arrSheetCopy, 2)).Value2 = arrSheetCopy
End Sub
This one is probably the fastest solution (even though it seems a bit bulky with much more lines of code when compared to the other solutions). That's due to the fact that this solution is doing most of the work in memory and not on the sheet. The entire sheet is loaded into a variable and then the work is done on the variable before the result (the variable) is written back to the sheet. So, if you have a speed problem then you might want to consider using this solution.
Here is one possible that meets your sample data's expectations.
Sub wqewqwew()
Dim i As Long, fc As Variant, lc As Long
'necessary if you do not want to confirm numbers and blanks in any row
On Error Resume Next
With ThisWorkbook.Worksheets("Sheet6")
For i = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
If CBool(Application.Count(Rows(i))) Then
fc = Intersect(.Rows(i), .UsedRange).Offset(0, 1).SpecialCells(xlCellTypeConstants, xlNumbers).Cells(1).Column
If Not IsError(fc) Then
lc = Application.Match(9 ^ 99, .Rows(i))
On Error Resume Next
With .Range(.Cells(i, fc), .Cells(i, lc))
.SpecialCells(xlCellTypeBlanks).Cells.FormulaR1C1 = "=RC[-1]"
.Value = .Value2
End With
End If
End If
Next i
End With
End Sub
Just another solution:
The following code can help is there you need to auto-fill the previous values between 1st and last cells depending on value of 1st cell as mentioned in question Excel - VBA fill in cells between 1st and Last value
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 2 To Target.Column
If Cells(Target.Row, i) = "" Then
If Cells(Target.Row, i - 1) <> "" Then
Range(Cells(Target.Row, i), Cells(Target.Row, i)).Value = Range(Cells(Target.Row, i - 1), Cells(Target.Row, i - 1)).Value
End If
End If
Next i
End Sub
This sub is activated by clicking on any cell. Same cell marks the end of the loop i.e. to stop the loop just click the cell till which you want to fill the blank cells.
I am trying to creat a form in excel using VBA, but I am stuck at the Code. I need to find out the code to enter a data to my worksheet using VBA form . here is the code I am using, but doesn't work..
Private Sub cmdAdd_Click()
Dim LastRow As Range
Dim DPDIAdhocRequestTable As ListObject
With LastRow
Cells(1, 2) = RequesterName.Value
Cells(1, 3) = RequesterPhoneNumber.Value
Cells(1, 4) = RequesterBureau.Value
Cells(1, 5) = DateRequestMade.Value
Cells(1, 6) = DateRequestDue.Value
Cells(1, 7) = PurposeofRequest.Value
Cells(1, 8) = ExpectedDataSaurce.Value
Cells(1, 9) = Timeperiodofdatarequested.Value
Cells(1, 10) = ReoccuringRequest.Value
Cells(1, 11) = RequestNumber.Value
Cells(1, 12) = AnalystAssigned.Value
Cells(1, 13) = AnalystEstimatedDueDate.Value
Cells(1, 14) = AnalystCompletedDate.Value
Cells(1, 15) = SupervisiorName.Value
End With
End Sub
can you help me to figure out the correct code for enter command?
thank you so much for your help.
As #Adam said - you've created LastRow and not assigned it to anything.
I'm guessing it's the next row you want to paste your data into, so it should be a Long holding the row number rather than an actual reference to the cell.
In the code below you could qualify the form controls by adding Me., for example Me.RequesterName.Value
https://msdn.microsoft.com/en-us/library/office/gg251792.aspx
Private Sub cmdAdd_Click()
Dim wrkSht As Worksheet
Dim LastRow As Long
'The sheet you want the data to go into.
Set wrkSht = ThisWorkbook.Worksheets("Sheet1")
'You're after the last row number, rather than referencing the range so LastRow is a Long.
'This looks for the last cell containing data in column A (the 1 in 'Cells(...)').
LastRow = wrkSht.Cells(Rows.Count, 1).End(xlUp).Row + 1
'With... End With block. Cells is preceded by a '.' notation - indicating it's referencing the 'With wkrSht'#
'https://msdn.microsoft.com/en-us/library/wc500chb.aspx
With wrkSht
'Using LastRow as row number in cell reference.
.Cells(LastRow, 2) = RequesterName.Value
'Before adding dates to the sheet you might want to check that the
'user entered a date and not rubbish.
.Cells(LastRow, 5) = DateRequestMade.Value
'You could use CDATE to force it to a date - will try and coerce the entered text into a date.
'Note - 1 will be changed to 01/01/1900 (so will need to add extra code to check it really is a date).
.Cells(LastRow, 5) = CDate(DateRequestMade.Value)
End With
End Sub
The first problem is that you've created a Range named LastRow but haven't assigned anything to it.
'Declaration
Dim LastRow As Range
'Assigns the last row based on the last item in Column A
Set LastRow = Range("A" & Rows.Count).End(xlUp).Row
With LastRow
...
End With
The second issue is a minor syntax error in your With LastRow block.
With LastRow
Cells(x,y).Value = "Foo"
End With
Should be
With LastRow
.Cells(x,y).Value = "Foo"
End With
Which is essentially the same as saying LastRow.Cells(x,y).Value = "Foo". Without the "." in front of Cells() VBA will not apply the With to that object, and assume you meant ActiveSheet.Cells()
I'm brand new to VBA for excel (like a few hours ago new) and not really a programmer, so bear with me.
I have an excel data set, all in one column (column A) that is structured like this:
Data
Data
Data
Data
Data
Data
Data
Data
Data
Data
Data
Data
Data
That is, the data blocks are separated by blank rows, but not at regular intervals. I'm trying to write a macro that will go through the file and Group (the specific excel command) these blocks of data together. So far I have this:
Set firstCell = Worksheets("627").Range("A1")
Set currentCell = Worksheets("627").Range("A1")
Do While Not IsEmpty(firstCell)
Set firstCell = currentCell
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If IsEmpty(nextCell) Then
Range("firstCell:currentCell").Select
Selection.Rows.Group
Set firstCell = nextCell.Offset(1, 0)
Else
Set currentCell = nextCell
End If
Loop
Loop
I'm sort of stuck, having particular trouble with the logic of moving to the next block of data and initiating.
Any help would be appreciated!
How about something like this:
Option Explicit
Public Sub tmpTest()
Dim i As Long
Dim lngLastRow As Long
With ThisWorkbook.Worksheets(1)
lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lngLastRow To 1 Step -1
If .Cells(i, 1).Value2 = vbNullString Then
.Range(.Cells(i + 1, 1), .Cells(lngLastRow, 1)).EntireRow.Group
lngLastRow = i - 1
End If
Next i
.Range(.Cells(1, 1), .Cells(lngLastRow, 1)).EntireRow.Group
End With
End Sub
Here ya are. You just need to pull addresses in your range instead of trying to refer to the object. You also need to reset both current and first cell in your if statement.
Sub test()
Set firstCell = Worksheets("test2").Range("A1")
Set currentcell = Worksheets("test2").Range("A1")
Do While Not IsEmpty(firstCell)
Set firstCell = currentcell
Do While Not IsEmpty(currentcell)
Set nextcell = currentcell.Offset(1, 0)
If IsEmpty(nextcell) Then
Range(firstCell.Address, currentcell.Address).Select
Selection.Rows.group
Set currentcell = nextcell.Offset(1, 0)
Set firstCell = nextcell.Offset(1, 0)
Else
Set currentcell = nextcell
End If
Loop
Loop
End Sub
First of all, your code goes wrong when it says
Range("firstCell:currentCell").Select
You are trying to select the range named "firstCell:currentCell" instead of
selecting range from first Cell to currentCell
You should change it to
.Range(firstCell,currentCell).select
Try using below code and see if it does what you want it to do
Dim GROUP_LAST_CELL As Range
With Worksheets("627")
LAST_ROW = .Range("A" & Rows.Count).End(xlUp).Row
I = 1
While I <= LAST_ROW
Set GROUP_LAST_CELL = .Cells(I, 1).End(xlDown)
.Range(.Cells(I, 1), GROUP_LAST_CELL).Rows.Group
I = GROUP_LAST_CELL.Row + 2
Wend
End With
According to what i understood from the question, i think what you want to do is to loop across all the elements in a particular column, skipping all the blanks.
You can do so by
Calculating the lastrow of the column
Looping across from the first row count to the calculated lastRow count
Applying a condition within the loop to only print the non-empty cells
Code Block
Sub test()
Dim j As Long, lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To lastRow
If Cells(j, "A").Value <> "" Then
MsgBox (Cells(j, "A").Value)
End If
Next j
End Sub
I Hope this helped!
I need some help with this macro. I have a workbook that is formatted pretty poorly, but consistently every time I open it. Among other things, the goal is to find the non-blank cells in column B and delete the entire 2 rows below and the 1st row above each of those populated B cells.
The first loop I have in the code works just the way I want it to, but the second loop seems to only work on the 1st instance of a populated B cell, but then it deletes everything else above it, like 500 cells worth of data.
Can someone explain to me why this is happening, and if you could find a way to combine both of those for loops into 1, that would be nice too.
Sub test()
Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long, lastCol As Long
Dim colNames As Variant
Dim i As Integer, j As Integer
Set currentSht = ActiveWorkbook.Sheets(1)
Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For i = lastRow To 1 Step -1
If currentSht.Cells(i, "B").Value <> "" Then
currentSht.Cells(i, "B").Offset(1).EntireRow.Delete
End If
Next i
Range("D3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlUp
currentSht.Rows("1:1").EntireRow.Delete
currentSht.Range("c:d, f:g, i:k").EntireColumn.Delete
currentSht.Range("A:D").Columns.AutoFit
For j = lastRow To 2 Step -1
If currentSht.Cells(j, "B").Value <> "" Then
currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete
End If
Next j
End Sub
Thank you
The second loop deletes everything because upon deletion of the lines above the found value, said value gets moved up and will be found again, triggering another deletion. To fix this, the quickest way would be to skip the next two lines by modifying j:
For j = lastRow To 2 Step -1
If currentSht.Cells(j, "B").Value <> "" Then
currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete
j = j - 2
End If
Next j
It really doesn't matter much if you are looping from top to bottom or vice versa. The only difference would be if there are two entries in column B near each other. In that case, the search order would determine which one is deleted. But is deletion really what you want? Maybe you could .Clear the contents of the rows instead of deleting them.
edit: here's the new code a bit cleaned up
Sub test()
Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long, lastCol As Long
Dim colNames As Variant
Dim i As Integer, j As Integer
Set currentSht = ActiveWorkbook.Sheets(1)
Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For i = lastRow To 1 Step -1
If currentSht.Cells(i, "B").value <> "" Then
'reference the row directly
currentSht.Rows(i + 1).Delete
End If
Next i
'Do not use selection if you can avoid it
Range("D3", Range("D3").End(xlToRight)).Delete Shift:=xlUp
currentSht.Rows(1).Delete
currentSht.Range("C:D, F:G, I:K").Delete
currentSht.Range("A:D").Columns.AutoFit
For j = lastRow To 2 Step -1
If currentSht.Cells(j, "B").value <> "" Then
currentSht.Rows(j - 1).Delete
currentSht.Rows(j - 2).Delete
j = j - 2
End If
Next j
End Sub
If you want to combine the loops the behavior of the macro will change because of the deletions that happen between the loops.