Well I have done a lot of research and found a lot of relevant questions and answers but couldn't quite figure out how to cater that information to my specific need.
I am working on a project to create a macro that will correct mistakes and fill in information commonly found in product catalogs that I work with.
One thing I am trying to accomplish is to give the value "unassigned" to each blank cell in a row that is marked "Y" in column B.
I've found out how to change every cell in those particular rows and have it adjust dynamically to the number of rows. What I can't figure out is how to do the same for the number of columns. In my code below everything between columns B and S is included. Column B will always be in the same spot but column S will not always be the last column.
Dim tracked As String
Dim endCell As Range
Dim endRow As Long
Dim endColumn As Long
Dim start As Long
endRow = ActiveSheet.Range("D2").End(xlDown).Row
endColumn = ActiveSheet.Range("A1").End(xlToRight).Column
Let tracked = "B2:" & "B" & endRow
Set trackItem = ActiveSheet.Range(tracked)
For Each y In trackItem
If Left(y.Value, 1) = "Y" Then
'start = y.Row
'Set endCell = ActiveSheet.Cells(endColumn, start)
ActiveSheet.Range("B" & y.Row & ":" & "S" & endColumn).Value = "Unassigned"
End If
Next y
I included some code that I've left commented out so you can see what I've tried.
So, I can successfully change the value of all cells within that range but I need to know how to do it with a range where the number of columns will not always be the same. In addition, I want to select the blank cells only within this range and assign them a value. I imagine this will need to be done row by row as the correct criteria will not always be together.
I'm surprised more people don't use 'UsedRange' when there is a need to loop through all the cells that have data on a sheet. (Just yesterday someone was complaining that it takes too long to loop through all 17,179,869,184 cells on a worksheet...)
This example lists & counts the "used" range, and will easily adapt to your needs.
Sub List_Used_Cells()
Dim c As Range, x As Long
For Each c In ActiveSheet.UsedRange.Cells
Debug.Print c.Address & " ";
x = x + 1
Next c
Debug.Print
Debug.Print " -> " & x & " Cells in Range '" & ActiveSheet.UsedRange.Address & "' are considered 'used'."
End Sub
Related
Hello stackoverflow community,
I must confess I primarily code within MS Access and have very limited experience of MS Excel VBA.
My current objective is this, I have an expense report being sent to me with deductions in another countries currency, this report has many columns with different account names that may be populated or may be null.
I currently have a Macro that will open an input box and ask for the HostCurrency/USD Exchange rate, my next step will be to start at on the first record (Row 14; Column A-K contains personal info regarding the deduction) then skip to the first deduction account (deduction accounts start at column L and span to column DG) checking if each cell is null, if it is then keep moving right, if it contains a value then I want to multiply that value by my FX rate variable that was entered in the input box, and update the cell with the converion. Once the last column (DG) has been executed I want to move to the next row (row 15) and start the process again all the way until the "LastRow" in my "Used Range".
I greatly appreciate any feedback, explanations, or links that may point me towards my goal. Thank you in advance for taking the time to read though this!
First off, you really should attempt to write the code yourself and post what you have so someone can try to point you in the right direction. If your range is going to be static this is a very easy problem. You can try something along the lines of:
Sub calcRate(rate As Double, lastrow As Integer)
Dim rng As Range
Set rng = Range("L14" & ":DG" & lastrow)
Dim c As Variant
For Each c In rng
If c.Value <> "" Then
c.Value = c.Value * rate
End If
Next
End Sub
This code will step through each cell in the given range and apply the code without the need for multiple loops. Now you can call the calcRate sub from your form where you input the rate and lastrow .
This will do it without looping.
Sub fooooo()
Dim rng As Range
Dim mlt As Double
Dim lstRow As Long
mlt = InputBox("Rate")
With ActiveSheet
lstRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(14, 12), Cells(lstRow, 111))
rng.Value = .Evaluate("IF(" & rng.Address & " <>""""," & rng.Address & "*" & mlt & ","""")")
End With
End Sub
If your sheet is static you can replace ActiveSheet with WorkSheets("YourSheetName"). Change "YourSheetName" to the name of the sheet.
Is it possible to transfer specific data from one worksheet to another?
What I want to do is to find all the data that has a specific string and transfer it to other worksheet. For example, I want to find data that has AC in it using the MID function, without any regards to its column and row, and transfer it to another worksheet.
So far, all I know is you need to have a specific range just like this code for it to work:
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For Each MyCell In Range("E2:E" & LastRow)
MyCell.Value = Mid(Range("A" & MyCell.Row), 6, 2)
Next
But the thing is it only searches a certain column, what I want is to search all the data inside a worksheet. Is this possible?
The main idea is to find / search something in this worksheet that correspond to a certain criteria.
get the data.
transfer it to another worksheet.
Something like this might help you out. You may have to tweak it to your suitability.
Sub TransferAC()
Dim C As Range
For Each C In Worksheets("Sheet1").Range("A1:B3").Cells
If InStr(1, LCase(C.Value), "ac", vbTextCompare) > 0 Then
Worksheets("Sheet2").Range(C.Address).Value = C.Value
End If
Next
End Sub
To test this, create Sheet1 like so (and create an empty Sheet2):
A B
1 testing racing
2 fencing dashing
3 pacing sleeping
When you run the procedure, Sheet2 will have
A B
1 racing
2
3 pacing
EDIT
If columns and rows are unknown but we know that they start from A1, simulate doing CTRL+DOWN-arrow-key to get the last non-empty cell in the same column and CTRL+RIGHT-arrow-key from A1 to get the last non-empty cell to the right. That will be assumed as the non-empty range.
Sub TransferAC()
Dim RangeString As String
Worksheets("Sheet1").Select
Range("A1").End(xlDown).Select
RangeString = Selection.Address
Range("A1").End(xlToRight).Select
RangeString = RangeString & ":" & Selection.Address
Dim C As Range
For Each C In Worksheets("Sheet1").Range(RangeString).Cells
If InStr(1, LCase(C.Value), "ac", vbTextCompare) > 0 Then
Worksheets("Sheet2").Range(C.Address).Value = C.Value
End If
Next
End Sub
The other alternative is to give range from A1:XFD1048576 (all cells), but that may become impractical to use.
I am new to VBA (as in I basically don't know anything about how to code in VBA, but I know python and general coding logic). I have an excel spreadsheet with a particular stock's data from 2004-2014 for every day the NYSE has been open. This data includes about 20 columns, but there are only 3 that I care about: the date (col a), a column with a specific percentage (col h), and a column with the price (col k). I want to write a simple program such that:
1) locate first positive percentage from column h, and the values in the same row for column a and k (i.e., if it's the third row, then find values from cells A3, H3, and K3)
2) locate the first negative percentage following the first positive percentage from step 1 in the same column h, and its corresponding values from column a and k (i.e., if it's the 7th row, then find values from cells A7, H7, and K7)
3) find the % difference of the 2 values found in the k column from the above two steps, and the difference in the number of rows from the positive and the negative percentage (i.e. 7-3=4)
4) Do this for the entire set of data which has almost 3000 rows of data - for example, after completing steps 1, 2, and 3, the program should find the first positive percentage following the negative percentage in step 2, then find the first negative percentage after that, and then find the % difference of the values in the k column and the difference in the number of rows
5) Place the information from the first 4 steps into a new spreadsheet (the values in the A, H, and K columns, the % differences, and the difference in the number of rows from the positive percentage and the negative percentage)
Can someone please write the VBA code for me for this, as I am new to VBA but need to get this done by tomorrow! Also, any tips on how to get started learning VBA would be very much appreciated! Thanks in advance, and Happy New Year!
Please let me know if you need anything clarified.
Just an idea:
Sub CompareData()
Dim srcwsh as Worksheet, dstwsh as Worksheet
Dim i as Integer, j as Integer
'source worksheet
Set srcWsh = Thisworkbook.Worksheets(1) ' or Thisworkbook.Worksheets("SheetName")
'destination worksheet
Set dstWsh = Thisworkbook.Worksheets.Add(After:=Thisworkbook.Worksheets(Thisworkbook.Worksheets.Count))
'define headers
dstWsh.Range("A1") = "Date"
dstWsh.Range("B1") = "Percentage"
dstWsh.Range("C1") = "Price"
dstWsh.Range("C1") = "Difference"
'start searching from 2. row
i = 2
Do While srcwsh.Range("A" & i)<> ""
'if value of column H is positive
If srcwsh.Range("H" & i)>0 Then
'find first empty row in a destination worksheet
j = GetFirstEmptyRow(dstWsh)
Union(srcWsh.Range("A" & i), srcWsh.Range("H" & i), srcWsh.Range("K" & i)).Copy dstWsh.Range("A" & j)
dstWsh.Range("D" & j).Formula = "=IF(ISERROR(D" & j-1 & "-D" & j & "),'',D" & j-1 & "-D" & j & ")"
End If
i = i+1
Loop
End Sub
Function GetFirstEmptyRow(ByVal wsh as Worksheet, ByVal Optional sCol As String = "A") As Integer
GetFirstEmptyRow = wsh.Range(sCol & wsh.Rows.Count).End(xlShiftUp).Row +1
End Function
Note: above code hasn't been tested!
All you need to do is to change the code to your needs. Good luck!
This question already has answers here:
Excel VBA deleting rows in a for loop misses rows
(4 answers)
Closed 4 years ago.
I have been coding a macro in Excel that scans through a list of records, finds any cells with "CHOFF" in the contents, copying the row that contains it, and pasting those cells into another sheet. It is part of a longer code that formats a report.
It has worked just fine, except that the "For Each" loop has been skipping over some of the entries seemingly at random. It isn't every other row, and I have tried sorting it differently, but the same cells are skipped regardless, so it doesn't seem to be about order of cells. I tried using InStr instead of cell.value, but the same cells were still skipped over.
Do you have any idea what could be causing the code just not to recognize some cells scattered within the range?
The code in question is below:
Dim Rng As Range
Dim Cell As Range
Dim x As Integer
Dim y As Integer
ActiveWorkbook.Sheets(1).Select
Set Rng = Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
x = 2
For Each Cell In Rng
If Cell.Value = "CHOFF" Then
Cell.EntireRow.Select
Selection.Cut
ActiveWorkbook.Sheets(2).Select
Rows(x).Select
ActiveWorkbook.ActiveSheet.Paste
ActiveWorkbook.Sheets(1).Select
Selection.Delete Shift:=xlUp
y = x
x = y + 1
End If
Next Cell
The For Each...Next loop doesn't automatically keep track of which rows you have deleted. When you delete a row, Cell still points to the same address (which is now the row below the original one, since that was deleted). Then on the next time round the loop, Cell moves onto the next cell, skipping one.
To fix this, you could move Cell up one within the If statement (e.g. with Set Cell = Cell.Offset(-1,0)). But I think this is one of the rare cases where a simple For loop is better than For Each:
Dim lngLastRow As Long
Dim lngSourceRow As Long
Dim lngDestRow As Long
Dim objSourceWS As Worksheet
Dim objDestWS As Worksheet
Set objSourceWS = ActiveWorkbook.Sheets(1)
Set objDestWS = ActiveWorkbook.Sheets(2)
lngLastRow = objSourceWS.Range("C" & objSourceWS.Rows.Count).End(xlUp).Row
lngDestRow = 1
For lngSourceRow = lngLastRow To 1 Step -1
If objSourceWS.Cells(lngSourceRow, 3).Value = "CHOFF" Then
objSourceWS.Rows(lngSourceRow).Copy Destination:=objDestWS.Cells(lngDestRow, 1)
objSourceWS.Rows(lngSourceRow).Delete
lngDestRow = lngDestRow + 1
End If
Next lngSourceRow
This loops backwards (as per Portland Runner's suggestion) to avoid having to do anything about deleted rows. It also tidies up a couple of other things in your code:
You don't need to do any Selecting, and it's better not to (see this question for why)
You can specify a destination within Range.Copy rather than having to do a separate select and paste
You can change the value of a variable "in place" without having to assign it to a second variable first (i.e. x = x + 1 is fine)
you should use Long rather than Integer for variables that contain row numbers, since there are more rows in an Excel spreadsheet than an Integer can handle (at least 65536 compared to 32767 max for an Integer)
Obviously test that it still does what you require!
Try using Selection.Copy instead of Selection.Cut
If you have to remove those lines you can mark the lines (for example writing something in an unused cell) inside the loop and then remove it once finished the main loop.
Regards
I had a similar issue when I was trying to delete certain rows. The way I overcame it was by iterating through the loop several times using the following:
For c = 1 To 100
Dim d As Long: d = 1
With Sheets("Sheet")
For e = 22 To nLastRow Step 1
If .Range("G" & e) = "" Or .Range("I" & e) = "" Then
.Range("G" & e).EntireRow.Delete
.Range("I" & e).EntireRow.Delete
d = d + 1
End If
Next
End With
c = c + 1
Next
So, basically if you incorporate the outer for loop from my code into your code, it should work.
I’ve been working on this VBA code for a while and since I’m a complete noob I feel like I haven’t gotten anywhere. I’ve been researching a ton, but can’t seem to combine answers to help with my scenario.
Essentially what I’m trying to do is grab data, line by line, from one worksheet and extrapolate it to another worksheet. I believe this will involve loops and I’m so new with VBA I don’t know how to do it.
Here’s the logic I’m attempting:
For each row on worksheet 1, I would like to perform 3 different copy and paste activities to worksheet 2 and then it will loop down to the next row on sheet1 and do the 3 activities and so on. This will continue downwards until column A is blank in sheet1. Sheet1 data starts at A3 and sheets2 paste area starts at A2.
The first activity is to copy cells F3,D3,A3, and H3 (in that order so F3 will be A2, D3 will be B2 etc) from sheet 1 to sheet 2 to A2,B2,C2, etc. A destination functions can’t be used because I need just the values and no other formats—one of the many issues I’ve ran in to.
The next activity is to copy cells F3,D3,A3 and I3 from sheet 1 to sheet2 pasted below the previous copy and paste—again no formats just values. Also to note, some of these may be blank (except A column) but I still need that row there with at least column A data—this goes to say with all these activities.
The third activity is to copy and paste sheet1’s F3,D3, and A3 a certain number of times referencing K3’s number—and each copy and paste will be in the next available blank cell. So if the number in K3 it will look like it created 3 rows in sheet2—totaling 5 rows on sheet2 since activity1 and 2 each create their own row.
After these three activities are completed for row 3 on sheet 1, it will then move to row 4 and do the previous three activities and paste to sheet2. And again it will be pasting no formats and in the next blank row on sheet 2. Also again, this loop will stop once the cell in Column A is blank.
Below is my incomplete code. I don’t even think it will help one bit and it would probably be better not to even look at it. I’ve just started to get frustrated since I can’t even do a simple copy and paste, yet alone loops within loops. I also haven’t even started on my third activity. I greatly appreciate it!
Sub copyTest3()
Dim proj As Range, release As Range, pm As Range, lead As Range, coord As Range
Dim leadCopy As Range, coordCopy As Range
Dim i As Range
Set proj = Range("A3", Range("A3").End(xlDown))
Set release = Range("D3", Range("D3").End(xlDown))
Set pm = Range("F3", Range("F3").End(xlDown))
Set lead = Range("H3", Range("H3").End(xlDown))
Set coord = Range("I3", Range("I3").End(xlDown))
Set leadCopy = Union(pm, release, proj, lead)
Set coordCopy = Union(pm, release, proj, coord)
For i = 1 To Range(ActiveSheet.Range("A3"), ActiveSheet.Range("A3").End(xlDown))
leadCopy.Copy
Sheets("Sheet2").Activate
Range("A2").Select
ActiveSheet.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Sheet1").Activate
coordCopy.Copy
Sheets("Sheet2").Activate
Range("A2").Select
ActiveSheet.PasteSpecial xlPasteValues
Next i
End Sub
There are many ways to do this, and some are more efficient than others. My solution may not be the most efficient, but hopefully it will be easy for you to understand so that you can learn.
It's very difficult to understand what you're attempting to do in activity three, so I wasn't able to provide a solution to that step. Use my code as a template for step three and if you run into issues, feel free to leave a comment.
Notice that I don't use .Activate, .Select, or .Copy in this code. .Activate and .Select are huge efficiency killers, and they make it easier for your code to "break," so avoid using them when possible. .Copy isn't necessary when working with values or formulas and will also slow your code down.
Untested
Sub testLoopPaste()
Dim i As Long
Dim ii As Long
Dim i3 as Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Sheet1")
Set sht2 = wb.Sheets("Sheet2")
'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
ii = 2
'This is the beginning of the loop
For i = 3 To LastRow
'First activity
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
sht2.Range("D" & ii) = sht1.Range("H" & i).Value
ii = ii + 1
'Second activity
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
sht2.Range("D" & ii) = sht1.Range("I" & i).Value
ii = ii + 1
'Third activity
For i3 = 1 To sht1.Range("K" & I)
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
ii = ii + 1
Next i3
Next i
End Sub
The way I usually approach copying data between sheets in Excel is to create source range and destination range objects, each range referring to just one row. When I want to move on to the next row, I use Offset to return a range offset to the next row.
Since the ranges only refer to one row, you can index them with an integer to get the cells in the row. E.g. if cursor refers to columns A through D in row 3, cursor(3) will give you the cell C3.
Dim src_cursor As Range
Dim dest_cursor As Range
Set src_cursor = ActiveSheet.Range("A3:I3")
Set dest_cursor = Sheets("Sheet2").Range("A2:D2")
'' Loop until column A is empty in source data
Do Until IsEmpty(src_cursor(1))
dest_cursor(1) = src_cursor(6) '' copy F -> A
dest_cursor(2) = src_cursor(4) '' copy D -> B
'' and so on
'' move cursors to next row
Set src_cursor = src_cursor.Offset(1, 0)
Set dest_cursor = dest_cursor.Offset(1, 0)
Loop
Also, this might be getting a little off topic, but it's a better practice to use an Enum to name the column numbers instead of hardcoding them like I did here.