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
Related
This question already has answers here:
Excel VBA - Delete Rows Based on Criteria
(2 answers)
Closed 4 years ago.
In Excel, I want to delete entire row if a cell is blank.
This should count for A17:A1000.
Running the script it returns the error:
Run-time 1004 error
Method Range of object global failed
If I replace A17:A1000 with A it deletes some rows.
Sub DeleteBlanks()
Dim r As Long
Dim m As Long
Application.ScreenUpdating = False
m = Range("A17:A1000" & Rows.Count).End(xlUp).Row
For r = m To 1 Step -1
If Range("A17:A1000" & r).Value = "" Or Range("A17:A1000" & r).Value = 0 Then
Range("A17:A1000" & r).EntireRow.Delete
End If
Next r
Application.ScreenUpdating = True
End Sub
The main issue in your code is that it is counting wrong.
"A17:A1000" & r does not count the rows up but appends the number r to that string. So eg if r = 500 it will result in "A17:A1000500" but not in "A17:A1500" as you might expected.
To delete all rows where column A has a blank cell you can use
Option Explicit
Public Sub DeleteRowsWithBlankCellsInA()
Worksheets("Sheet1").Range("A17:A1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
This one deletes all blank lines at once and therefore is pretty fast. Also it doesn't need to disable ScreenUpdating because it is only one action.
Or if blank and zero cells need to be deleted use
Option Explicit
Public Sub DeleteRowsWithBlankOrZeroCellsInA()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'define which worksheet
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim iRow As Long
For iRow = LastRow To 1 Step -1
If ws.Cells(iRow, "A").Value = vbNullString Or ws.Cells(iRow, "A").Value = 0 Then
ws.Rows(iRow).Delete
End If
Next iRow
End Sub
This one deletes line by line. Each delete action takes its time so it takes longer the more lines you delete. Also it might need to disable ScreenUpdating otherwise you see the line-by-line action.
An alternative way is to collect all the rows you want to delete with Union() and then delete them at once.
Option Explicit
Public Sub DeleteRowsWithBlankOrZeroCellsInA()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'define which worksheet
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim DeleteRange As Range
Dim iRow As Long
For iRow = LastRow To 1 Step -1 'also forward looping is possible in this case: For iRow = 1 To LastRow
If ws.Cells(iRow, "A").Value = vbNullString Or ws.Cells(iRow, "A").Value = 0 Then
If DeleteRange Is Nothing Then
Set DeleteRange = ws.Rows(iRow)
Else
Set DeleteRange = Union(DeleteRange, ws.Rows(iRow)) 'collect rows to delete
End If
End If
Next iRow
DeleteRange.Delete 'delete all at once
End Sub
This is also pretty fast because you have again only one delete action. Also it doesn't need to disable ScreenUpdating because it is one action only.
In this case it is also not necessary to loop backwards Step -1, because it just collects the rows in the loop and deletes at once (after the loop). So looping from For iRow = 1 To LastRow would also work.
There are multiple errors in your code.
First of all, your procedure should have it's scope declared.
Presumably in your case Private
You are incorrectly defining your Range() Please look at its definition
Range.Value = 0 is not the same as Range = "" or better yet IsEmpty(Range)
Looping from beginning to end when deleting individual rows will cause complications (given their indexes [indices(?)] change) - or to better word myself - it is a valid practice, but you should know what you're doing with the indexes. In your case it seems much easier to them them in the LIFO order.
Last but not least, you're unnecessarily complicating your code with certain declarations (not an error so to say, but something to be improved upon)
With all the considered, your code should look something like this:
Option Explicit
Private Sub remove_empty_rows()
Dim ws as Worksheet: Set ws = Sheets("Your Sheet Name")
Dim lr as Long
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim i as Long
For i = lr to 1 Step -1
If IsEmpty(ws.Cells(i, 1)) Then
ws.Rows(i).Delete
End If
Next i
End Sub
In general, without meaning to sound condescending, it looks like you have some learning gaps in your coding practice. I'd refer properly reading some documentation or tutorial first, before actually doing coding like this yourself.
Taking into account that A17 cell is a header, you could use AutoFilter instead of iterating over cells:
Sub FastDeleteMethod()
Dim rng As Range, rngFiltered As Range
Set rng = Range("A17:A" & Cells(Rows.Count, "A").End(xlUp).Row)
With rng
.AutoFilter Field:=1, Criteria1:=0, Operator:=xlOr, Criteria2:="="
On Error Resume Next
Set rngFiltered = rng.SpecialCells(xlCellTypeVisible)
If Err = 0 Then rngFiltered.EntireRow.Delete
On Error GoTo 0
End With
End Sub
I'm trying to take the output of our scheduling software for a TV station and get rid of anything for given times. Unfortunately the output of the scheduling software creates a text field for time, not a field that can be formatted to time. I haven't done any real programming in over a decade and this is frustrating me. Here's a sample of the first few rows of the sheet - every day of the month contains entries for each program from 6:00a to the next day at 5:30a.
The code I've got so far is:
Sub delete_extraneous()
Dim rng As Range
Dim j As Integer
Dim m As Integer
m = 1
j = 3
Goto ActiveSheet.Cells(j, m)
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For m = 1 To lastRow
If rng = "6:30a" Or "7:00a" Or "7:30a" Or "8:00a" Or "8:30a" Or "9:00a" Or "9:30a" Or "10:00a" Or "10:30a" Or "11:00a" Or "11:30a" Then
ActiveCell.EntireRow.Delete Shift:=xlShiftUp
End If
Next m
End Sub
Use an array of text-that-looks-like-time and match against it.
Sub delete_extraneous()
dim tms as variant, lastRow as long
tms = array("6:30a", "7:00a", "7:30a", "8:00a", "8:30a", "9:00a", "9:30a", _
"10:00a", "10:30a", "11:00a", "11:30a")
with activesheet
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For m = lastRow to 1 step-1
If not iserror(application.match(.Cells(m, "C").value, tms, 0)) Then
.rows(m).EntireRow.Delete Shift:=xlShiftUp
End If
Next m
.
end with
end sub
You could use Autofilter():
Sub test()
Dim hours As Variant
hours = Array("6:30a", "7:00a", "7:30a", "8:00a", "8:30a", "9:00a", "9:30a", "10:00a", "10:30a", "11:00a", "11:30a")
With Range("C1", Cells(Rows.Count, 3).End(xlUp))
.AutoFilter Field:=1, Criteria1:=hours, Operator:=xlFilterValues
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If Not IsError(Application.Match(.Cells(1, 1).value, hours, 0)) Then .Rows(1).Delete
End With
ActiveSheet.AutoFilterMode = False
End Sub
You don't state what your specific issue is in the code, but I can tell you a few problems you have.
1) This is not valid syntax Goto ActiveSheet.Cells(j, m). There is a GoTo statement in VBA, but only use when absolutely necessary. (this case does not require it).
2) Don't rely on ActiveSheet. Instead reference the selected worksheet you desire to work with directly.
3) You never actually define rng so it's meaningless and your code will always bypass range. Using Option Explicit at the top of your modules can help avoid this issue.
4) Using active cell is also dangerous and may produce unintended consequences. In your case it will delete the same cell over and over and over again since you never activate any other cell. It's not needed.
See this code below. It also checks for row deletion and loads into a range for one delete statement later (which will be faster than deleting line by line, and doesn't require backwards looping).
Option Explicit
Sub delete_extraneous()
Dim mySheet As Worksheet
Set mySheet = Worksheets("mySheet") 'replace as needed
Dim lastRow As Long
lastRow = mySheet.Cells(mySheet.Rows.Count, 1).End(xlUp).Row
Dim m As Long
For m = 1 To lastRow
Select Case mySheet.Cells(m, 3).Value 'check each row against column C
Case Is = "6:30a", "7:00a", "7:30a", "8:00a", "8:30a", "9:00a", "9:30a", "10:00a", "10:30a", "11:00a", "11:30a"
Dim deleteRng As Range
If deleteRng Is Nothing Then
Set deleteRng = mySheet.Cells(m, 3)
Else
Set deleteRng = Union(deleteRng, mySheet.Cells(m, 3))
End If
End Select
Next
deleteRng.EntireRow.Delete
End Sub
This is my first post. I've been trying to teach myself excel VBA and it has been quite challenging.
Anyways I have been working on loops and ranges etc etc.
Here's my dilemma:
Option Explicit
Sub Move_Data()
Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim LastColumn As Long
Dim rng As Range
Dim result As String
result = "New Results"
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 3 To LastRow
For j = 1 To LastColumn
If Cells(i, 1) = result Then
j = j + 1
Cells(i, 1).Copy Destination:=ActiveSheet.Cells(i, j)
End If
Next j
Next i
End Sub
Little by little I have put the above together. Here's my question:
I am trying to look at all the values in column "A". Once "New Results" is found I want to copy not only this cell, but everything underneath it, to a column "J". Then find the string in column "B" and copy the range to column "K", etc.
So far the code finds "New Results" and moves it to column "B" which is expected since is the only code I have written. How can add another loop that will copy everything under "New Results" along with it and move it over to the new column. This way J will keep increasing and eventually I will have all the results broken down by columns.
Hopefully this makes sense.
Thanks all,
You dont have to loop through all the cells. Rather use the Find() method. It's more efficient I think.
Sub Move_Data()
Dim rngFound As Range
Dim intColLoop As Integer
Dim LastColumn As Integer
Dim result As String 'added in edit, forgot that, oops
Dim intColPaste As Integer 'added in edit
result = "New Results"
LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
With Cells
'in case the result is not on the ActiveSheet, exit code
If .Find(result) Is Nothing Then Exit Sub
'*****************Search all the columns, find result, copy ranges
'search all the columns
For intColLoop = 1 To LastColumn
With Columns(intColLoop)
'check if the result is in this column
If Not .Find(result) Is Nothing Then
'find the result
Set rngFound = .Find(result)
'copy the found cell and continuous range beneath it to the destination column
Range(rngFound, rngFound.End(xlDown)).Copy Destination:=Cells(Rows.Count, 10 + intColPaste).End(xlUp) 'Edit : changed the "10" to "10 + intColPaste"
intColPaste = intColPaste + 1 'Edit : added counter for columns
End If
End With
Next intColLoop 'proceed to next column
End With
End Sub
Very well written for your first post, congrats!
Option Explicit
Sub Move_Data()
Dim SourceCol As integer
Dim DestCol As Integer
Dim LastRow As Long
'Dim LastColumn As Long
Dim rng As Range
Dim result As String
Dim Addr as string
SourceCol = 1 'Column A
DestCol = 2 'Column B
result = "New Results"
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
set rng = ActiveSheet.Range(cells.Address).Find (What:=Result, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
While not rng is Nothing and Addr <> rng.Range.Address
'If not rng is Nothing
ActiveSheet.range(cells(rng.row, DestCol),cells(LastRow,DestCol) = _
ActiveSheet.range(cells(rng.row,SourceCol), cells(LastRow,SourceCol))
'End If
Addr = rng.range.address(ReferenceStyle:=xlR1C1)
set rng = ActiveSheet.Range(cells.Address).Find (What:=Result, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
wend
End Sub
Adjust SourceCol and DestCol as needed.
That's untested and off the top of my head, so it might need a minor tweak. Use .Find() to find your text, then set your destination range = to what you just found.
As written, it will find one occurrence of result. If you have multiple occurrences of result, comment out/delete the If... and 'End If` lines, then uncomment the 4 lines that are commented & they'll loop through, finding them all.
I need to remove the last the last two characters of all cells found in a worksheet named Target with the column name Order (column BD).
This macro below would have looked in row 1 Worksheet Target for the word orders. It then would have removed the last two characters (strings).
However since I am new and got these macros from two different sources I likely messed up in assigning variables.
Sub RemoveOrdersTT()
Dim ws As Worksheet
Dim rng As Range
Dim lastCol As Long
Dim i As Long
Set ws = Worksheets("Target")
With ws
lastCol = .UsedRange.Columns.Count
For i = 1 To lastCol
If InStr(1, UCase(.Cells(1, i).Value), "Orders") > 0 Then
.Cells(1, i).Value = Left(.Cells(1, i).Value, Len(.Cells(1, i).Value) - 2)
End If
Next i
End With
End Sub
A code that would look at worksheet Target and column BD starting at row 2 or a fix to my code would be much appreciated.
Change the inner if:
If InStr(1, UCase(.Cells(1, i).Value), "ORDER") > 0 Then
.cells(1,i).value = left(.cells(1,i).value, Len(.cells(1,i).value) -2)
End If
InStr requires 3 parameters (plus some optional ones), you were missing the first parm telling it where to start looking
In the If statement, InStr will return a position or 0, so testing for > 0 is sufficient, no need for <>, though that will work, it's just unnecessary
Remove the 2nd call to UCase() in the if statement itself, no need to UCase a fixed string, just provide it in upper case.
No need to mess with trying to create another range object and modifying that, you've already got the cell you need.
Also:
Assuming your data is rectangular (i.e. you don't have any columns without headers that you don't want to have searched):
LastCol = .UsedRange.Columns.Count
Is a much easier way of finding out how many columns are in use, and doesn't require moving the active cell about the worksheet.
Complete Code
Sub RemoveOrdersTT()
Dim ws As Worksheet
Dim rng As Range
Dim lastCol As Long
Dim i As Long
Dim r as long
Set ws = Worksheets("Target")
With ws
lastCol = .UsedRange.Columns.Count
For i = 1 To lastCol
If InStr(1, UCase(.Cells(1, i).Value), "Orders") > 0 Then
for r = 2 to .usedRange.Rows.Count
.Cells(r, i).Value = Left(.Cells(r, i).Value, Len(.Cells(r,i).Value) - 2)
next
End If
Next i
End With
End Sub
Had to add the inner loop For r... to actually get it to traverse the rows in that column
This is my first time to code in VBA.
I have several worksheets in a file and they are in order by dates.
So what I am trying to do is to collect data sets in a worksheet if they have the same period of time.
date1 value1
date2 value2
date3 value3
Since they are in order I just compare the first date values and if they are different it moves on to the next worksheet. If they are the same then copy the value and do the same process until it reaches the last worksheet.
However it copies one worksheet fine but after that Excel freezes.
I would be appreciated if you find any errors or give me other suggestions to do it.
Following is my code:
Sub matchingStock()
Dim sh1 As Worksheet, sh2 As Worksheet
' create short references to sheets
' inside the Sheets() use either the tab number or name
Set sh1 = Sheets("combined")
Dim col As Long
'since first column is for Tbill it stock price should place from the third column
col = 3
Dim k As Long
'go through all the stock worksheets
For k = Sheets("WLT").Index To Sheets("ARNA").Index
Set sh2 = Sheets(k)
' Create iterators
Dim i As Long, j As Long
' Create last rows values for the columns you will be comparing
Dim lr1 As Long, lr2 As Long
' create a reference variable to the next available row
Dim nxtRow As Long
' Create ranges to easily reference data
Dim rng1 As Range, rng2 As Range
' Assign values to variables
lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
Application.ScreenUpdating = False
' Loop through column A on sheet1
For i = 2 To lr1
Set rng1 = sh1.Range("A" & i)
' Loop through column A on sheet1
For j = 2 To lr2
Set rng2 = sh2.Range("A" & j)
' compare the words in column a on sheet1 with the words in column on sheet2
'Dim date1 As Date
'Dim date2 As Date
'date1 = TimeValue(sh1.Range("A3"))
'date2 = TimeValue(sh2.Range("A3"))
sh1.Cells(1, col).Value = sh2.Range("A1").Value
' find next empty row
nxtRow = sh1.Cells(Rows.Count, col).End(xlUp).Row + 1
' copy the word in column A on sheet2 to the next available row in sheet1
' copy the value ( offset(0,1) Column B ) to the next available row in sheet1
sh1.Cells(nxtRow, col).Value = rng2.Offset(0, 6).Value
'when the date is different skip to the next worksheet
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
'sh3.Rows("1:1").Delete
Else
GoTo Skip
End If
Skip:
col = col + 1
Next k
End Sub
I cannot identify a specific error so this is a list of suggestions that may help you identify the error and may help improve your code.
Suggestion 1
Do you think the Else block of If-Then-Else-End-If is compulsory?
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
Else
GoTo Skip
End If
Skip:
is the same as:
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
End If
Suggestion 2
I do not like:
For k = Sheets("WLT").Index To Sheets("ARNA").Index
The value of property Index for a worksheet may not what you think it is. This may not give you the set or sequence of worksheets you expect. Do you want every worksheet except "Combined"? The following should be more reliable:
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> sh1.Name Then
:
End If
Next
Suggestion 3
You use:
.Range("A" & Rows.Count)
.Range("A3")
.Cells(1, col).Value
.Cells(Rows.Count, col)
rng2.Offset(0, 6)
All these methods of identifying a cell or a range have their purposes. However, I find it confusing to use more than one at a time. I find .Cells(row, column) and .Range(.Cells(row1, column1), .Cells(row2, column2)) to be the most versatile and use them unless there is a powerful reason to use one of the other methods.
Suggestion 4
I cannot decypher what this code is attempting to achieve.
You say: "I have several worksheets in a file and they are in order by dates. So what I am trying to do is to collect data sets in a worksheet if they have the same period of time."
If you have set Worksheet("combined").Range("A3").Value to a particular date and you want to collect data from all those sheets with the same value in cell A3 then the outer For-Loop and the If give this effect. But if so, if does not matter how the worksheets are ordered. Also you start checking cell values from row 2 which suggests row 3 is a regular data row.
The outer loop is for each worksheet, the next loop is for each row in "combined" and the inner loop is for each row in the worksheet selected by the outer loop. The middle loop does not appear to do anything but set rng1 which is not used.
Perhaps you can add an explanation of what you are trying to achieve.
Suggestion 5
Are you trying to add an entire column of values from the source worksheets to "Combined". The macro below:
Identifies the next free row in column A of "Combined"
Identifies the last used row in column A of "Sheet2"
Assumes the first interesting row of "Sheet2" is 2.
Adds the entire used range of column A of "Sheet2" (complete with formatting) to the end of "Combined"'s column A in a single statement.
This may demonstrate a better way of achieving the effect you seek.
Sub Test()
Dim RngSrc As Range
Dim RngDest As Range
Dim RowCombNext As Long
Dim RowSrcFirst As Long
Dim RowSrcLast As Long
With Worksheets("Combined")
RowCombNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Set RngDest = .Cells(RowCombNext, "A")
End With
With Worksheets("Sheet2")
RowSrcFirst = 2
RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngSrc = .Range(.Cells(RowSrcFirst, "A"), .Cells(RowSrcLast, "A"))
End With
RngSrc.Copy Destination:=RngDest
End Sub