for loop cell contents into new cell X amount of times vba - vba

I have a column that contains 50 rows of text. I want to copy each cell and paste its value in a different column, but do so X amount of times based on a separate input. My mind defaults to thinking pythonically, and I want to append each item to a list for manipulation, though I don't think that is necessary in this instance.
Sub fipsloop()
finalRow = Cells(Rows.Count, "P").End(xlUp).Row
p = Worksheets("StateSource").Range("B3:").Select
p_count = WorksheetFunction.CountA(p)
Dim rng As Range, cell As Range
rng = Range("e3:finalRow")
For Each cell In rng
If x.Value = "" Then
Exit For
If p_count > 1 Then
'# here is where I am stuck.
Next cell
"p_count" is the number of times I want to paste each cell's contents into a different column. So if there are 50 items in column E, and my "p_count" variable is 2, then I will paste each item twice and will have 100 items in my new column.
In python I would append each item X amount of times to a list. Is there a way to do something like that within VBA?

Just use the .Value property in your loop. This will copy the value from column 5/E into cells in column 16/P very quickly:
For rowIndex = 1 to p_count
Worksheets("StateSource").cells(rowIndex, 16).Value = Worksheets("StateSource").cells(rowIndex, 5).Value
Next

Related

How to create a loop to read a range of cells and determine which have values and what is to the right of each

I'm trying to have a program that can read a range of cells which consist of 12 cells (let's say: P79, R79, T79, V79, X79, Z79, AB79, AD79, AF79, AH79, AJ79, AL79) and under those cells there are 6 cells (let's say: V81, X81, Z81, AB81, AD81, AF81), the program is looking for whether or not there are values typed in the cells within the described range.
The program should be able to read the cells from left to right on the top row and loop down to the bottom row and read that from right to left.
If all the cells in the top row have values in them, then the program breaks and doesn't read the values in the bottom row.
As the program reads the values from each cell it should create a table consisting of three columns (let's say: M88, N88, O88), the leftmost column should have the cell number (in order of cell as read by the program (whichever cell has a value first in the loop is given the number 1 and then the next cell to have a value is given number 2 etc.). The middle column should have whatever value is written in it's corresponding cell read from the range. The right column should have the value of whatever is to the right of each cell containing a value.
The first value to be read with a value should give the value "Left End" and the last value to read (whether or not it is the 12th cell to have a value in the top row or the leftmost cell to have a value in the bottom row) should give the value "Right end".
An example of what a row from the table could look like:
Cell # Cell Value Position/Left/Right
1 First Left End
This is the code I have so far:
Sub Code()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Integer, j As Integer, k As Integer
' First loop to compare a car to the rest after it
For i = 1 To 12
For j = i + 1 To 12
If Not IsEmpty(ws.Range("Cell_" & i)) And Not IsEmpty(ws.Range("Cell_" & j)) Then
ws.Range("B82").Offset(i).Value = j
Exit For
End If
Next j
Next i
' Loop backwards to find "Right End"
For k = 12 To 2 Step -1 '24 To 2
If Not IsEmpty(ws.Range("Cell_12")) Then
ws.Range("B82").Offset(12).Value = "Right End"
Exit For
' Has the "Right End" Follow when cars are left blank for lower row
ElseIf IsEmpty(ws.Range("Cell_" & k)) And Not IsEmpty(ws.Range("Cell_" & k - 1)) Then
ws.Range("B82").Offset(k - 1).Value = "Right End"
Exit For
End If
Next k
What I have here merely inserts a count into a cell range, what I'm trying to do is have my code actually read the cells in the range in the order I described and one at a time look at which cells have values written in them and look at which cells (with values in them) are to the right of any cell with a value and produce the table described above.
After reading your explanation, which was quite challenging I tried to recreate what you are asking.
I used cells A1:L1 with numbers 1 to 12. in the row below that A2:L2, some numbers have been added. with an if value <> "" you can see which cells contain a value.
In the second worksheet the table is made:
Sub test()
Dim a As Integer
Dim i As Integer
Dim name As String
ActiveWorkbook.Sheets(1).Activate
a = 1
For i = 1 To endcel
If Sheets(1).Range("a1").Offset(a, i - 1).Value <> "" Then
name = Sheets(1).Range("A1").Offset(a, i - 1).Value
Sheets(2).Activate
Sheets(2).Range("b2").Offset(i).Value = name
End If
Next i
End Sub
Does this help? You can adapt it a bit to your problem.
Good luck!

=LEFT(H2,5) To show data for all rows and stop at last row of data

Hi could someone enlighten me with some VBA code to insert formula =LEFT(H2,5) into column M and then stop at the last row of data.
The data it will be referencing will be inserted from the web so when i refresh the data pull the rows could be more or less so it can't be a fixed without using VB
Thanks
Rhys
You don't need a loop for this:
Sub qwerty()
Dim N As Long, r As Range
N = Cells(Rows.Count, "H").End(xlUp).Row
Set r = Range("M2:M" & N)
r.Formula = "=LEFT(H2,5)"
End Sub
You will find that the addresses in the formulas adjust just like in copy/paste.
Would a while loop work for you?
Dim i As Integer
i = 2 'starting row number
While Cells(i, 1).Value <> "" 'Empty row
Cells(i, 13).Formula = "=LEFT(H2,5)" 'replace this with something for that row, concatenating i to H will work i think.
i = i + 1
Wend
You'll also want to put this code to whenever the data is refreshed so it inserts the formula to all rows again.
Dim x As Long
x = Application.CountA(ActiveSheet.Columns(13))
ActiveSheet.Cells(2, 13) = "=LEFT(H2,5)"
ActiveSheet.Cells(2, 13).Resize(x - 1).Formula = ActiveSheet.Cells(2, 13).Formula
use excel function CountA to get the total number of row that you need to populate and assign that number to x
then put the actual formula on cells M2 then copy the formula until the last row using resize function

VBA macro script : Find and copy unique values within a column in sheet 1 to sheet 2 using vba macro

I have 2 sheets within the same workbook. In worksheet A called "sheet1" and worksheet B called "sheet2". From column A of sheet 1 there are upto 176080 records of duplicate ID numbers. Need to find the unique ID numbers from this column and paste it into column A of sheet 2.
Any help would be appreciated, I am new to VBA macro and found some codes online but do not understand it. Please help me and kindly provide a syntax to solve this with some explanation so I could learn how to do it on my own as well. Thanks!!
May be a little complicated, but this gives back the unique numbers in column "A".
Option Explicit
Dim i, j, count, lastrow As Integer
Dim number As Long
Sub find_unique()
lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For i = 1 To lastrow
number = Cells(i, 1)
For j = 1 To lastrow
If number = Cells(j, 1) Then
count = count + 1
End If
Next j
If count = 1 Then
Cells(i, 5) = number
Else
Cells(i, 5) = ""
End If
count = 0
Next i
End Sub
First the sub takes cell A1 then loops through all other cells, starting at the first, to the last cell in the active Sheet. If a number is equal to more than one cell (it's allways one, because u also check the cell with it's own value) the number will not be displayed in column E. Then it takes the next number and loops through all again until every number is checked. Small changes and the numbers will be shown in the other sheet. Hope it works for you.

Macro: Given row X copy specific cells from that row to a new sheet

I am working on a way to generate a list based on the value of each row in a given column (G). Currently the list can copy entire rows and works perfectly. It pulls all rows if column G contains the required text ("Card") and puts them in a list on another spreadsheet with no gaps.
The problem is that I want the list to only contain information from a few columns in each row containing "Card", not the whole row.
Is there a way to make my code below pull specific cells from a row rather than using the .EntireRow function and copy the whole row?
To clarify, this spreadsheet is updated regularly by multiple different users so the information is not static. Rows are added and changed frequently and occasionally deleted. As such I cannot just copy cell values from the original sheet to the new list.
Sub AlonsoApprovedList()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
Dim ExistCount As Long
ExistCount = 0
MyCount = 1
'----For every cell in row G on the ESI Project Data sheet----'
For Each cell In Worksheets("ESI Project Data").Range("G6:G5000")
If cell.Value = "Card" Then
ExistCount = ExistCount + 1
If MyCount = 1 Then Set NewRange = cell.Offset(0, -1)
'----Sets up a new range to copy all data from the row if column G in that row contains the value in question----'
Set NewRange = Application.Union(NewRange, cell.EntireRow)
MyCount = MyCount + 1
End If
Next cell
If ExistCount > 0 Then
NewRange.Copy Destination:=Worksheets("Alonso Approved List").Range("A3")
End If
End Sub
Additional information:
Column G drop down data validation lists containing one several
items. A complete list is in a different worksheet. Users go in to
each line item and select from a specific category.
The other columns in question contain a line item's name, category
(same as column G), a monetary value, and a date.
The code above loops through a list in the "ESI Project Data" Worksheet and detects rows by the value in cell G. It currently copies the whole row every time a key word is in cell G ("Card") in this example. I am using it to generate individual lists grouped by that key word. I just want it to pull individual cells, not use the .EntireRow function as it currently does. I do not know how to do that.
Thank you for your time!
Untested...
Sub AlonsoApprovedList()
Dim cell As Range
Dim rngDest As Range
Dim i As Long
Dim arrColsToCopy
arrColsToCopy = Array(1, 3, 4, 5)
'----For every cell in row G on the ESI Project Data sheet----'
Set rngDest = Worksheets("Alonso Approved List").Range("A3")
Application.ScreenUpdating = False
For Each cell In Worksheets("ESI Project Data").Range("G6:G5000").Cells
If cell.Value = "Card" Then
For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
With cell.EntireRow
.Cells(arrColsToCopy(i)).Copy rngDest.Offset(0, i)
End With
Next i
Set rngDest = rngDest.Offset(1, 0) 'next destination row
End If
Next cell
Application.ScreenUpdating = True
End Sub
hello is there a code that I can use to copy specific cells to another workbook by clicking a button.
here's what I am trying to do,
from workbook 1 I need to copy info from the following cells
I have Column B info on cell A40 to A69
I have Column B info on cell b2, b3, b4, b8,9,10,11,12,13,14,15 and b40 to b69
I have column D info on cells b2,
I have column G info on cell b1,b2,b3,b4
all this I need to send it to workbook2 which has the same cells assigned to this specific info.
hope I made my self clear.

Extract data from indeterminate range size in Excel

I'm new to VBA, and I'd love some help.
I have a spreadsheet that has a range that will always have 10 columns, but could have X amount of rows. I'm trying to write a VBA script that will iterate over this range and extract the values out of each cell.
For example, if I have 2 rows I need A1, B1, C1..J1 and then I need A2, B2, C2...J2. The next time I could have 5 rows and then another time 3.
How do I setup my loop to make this work?
something like
Dim lastRow as long
lastRow = UsedRange.Rows.Count 'or some other way of determining the last row used
for i = 1 to lastRow 'loop through all used rows
'ActiveSheet.Cells(i, 1).value 'column A
'ActiveSheet.Cells(i, 2).value 'column B
'ActiveSheet.Cells(i, 3).value 'column C
next i
You could also use a dynamic named range and loop through that. See this link or google for better examples. Dynamic name ranges are powerful, especially for charts.
For your example you would set the name range reference to;
=OFFSET(Sheet1!$A$1,0,0,COUNT(Sheet1!$A:$A),10) '10 is the width and will go to column J
assuming that column A will have the true max row of the table.
Then;
Dim arr() As Variant
arr = Range("YourRangeName")
For x = 1 To UBound(arr,1) 'Finds the max number of rows in the array, UBound(arr,2) finds the total columns.
'Do some code here where x steps through the array arr
' = arr(x, 1) 'column a
' = arr(x,2) 'column b
' = arr(x,3) ....
Next x
It's almost always better/faster to process as much as you can in code, i.e. assigning a range in Excel to an Array then loop through the array rather than referencing cells (especially in a loops).