I have a report with several rows of data. One column (number column) in each row lists a random number from 1 to 99. I need to duplicate the row of data the number of times that are noted in the "number" column. Example: John Smith gets 32 chances in a contest. The number 32 is the "number". I need to duplicate John Smith's row of data 31 additional times so he has 32 rows. Make sense?
Name your number column "rangename"
Press alt+f11. Put this in
Public Sub CopyForEach()
Dim varcell as variant
Dim iiterator as integer
Dim icount as integer
For Each varcell in ThisWorkbook.Sheets(1).Range("rangename")
icount = varcell.value
For iiterator = 1 to icount
ThisWorkbook.Sheets(1).Range(varcell.address).(1,iiterator).value = icount
Next iiterator
Next
End Sub
Press F5.
Note: not tested.
Related
I am trying to make a sub that loops through 31 columns on one worksheet to find the number of 0's that exist in each column. Each column can have a different amount of data, up to 25,000 cells in each column. I need to take the number of 0's counted and paste it in the 47th row of each column. The data that I need to count starts in row 49 and can go to 25,049. My thought process was to count the number of rows with data instead of having VBA look through possible blank cells to save performance. When I ran the code below, it never counted more than 1 zero in each row. Most of them said there was no instances of a zero when there would be like 9 of them. I'm not sure where I'm going wrong.
Sub FindingZeros()
'________________________________________
'TO DO:
'Filter data in this workbook for 0's and
'count instances
'________________________________________
Dim zeros As Integer
Dim currcol As Integer
Dim temp As Worksheet
Set temp = Worksheets("306 Toyota 2.5L")
For currcol = 2 To 32
Dim lastrow1 As Long
lastrow1 = temp.Range(Cells(49, currcol), Cells(temp.Rows.Count, currcol)).End(xlUp).Row
zeros = Application.WorksheetFunction.CountIf(Range(Cells(49, currcol), Cells(lastrow1, currcol)), 0)
temp.Cells(47, currcol).Value = zeros
Next currcol
End Sub
The main issue you were having was identifying the last used row of a column, in this instance we do not need to know the range but just the last row, so lastrow1 only needs the last row number.
Then we do not need to set a variable of for the zeros as the value can be put directly in to the cell.
Refer to the comments:
Sub FindingZeros()
Dim currcol As Integer
Dim temp As Worksheet
Dim lastrow1 As Long
Set temp = Worksheets("306 Toyota 2.5L")
For currcol = 2 To 32
' find last used row of column
lastrow1 = Cells(temp.Rows.Count, currcol).End(xlUp).Row
' set the value of the cell to the counted zeroes.
Cells(47, currcol).Value = Application.WorksheetFunction.CountIf(Range(Cells(49, currcol), Cells(lastrow1, currcol)), 0)
Next currcol
End Sub
Using VBA, I'm making a sub that should, in some instances, output maybe hundreds of strings. Can I make a long MsgBox where all of those strings are occupying a different paragraph each? In my workbook, the worksheets have tables with the code of a product in the first column and the stock in the eighth (last), I have made the function AverageStock that returns the average stock of a certain product code in a worksheet.
Sub test()
Dim product_code as String
Dim LRow as Integer
Dim k as Integer
LRow = Range("A3").End(xlDown).Row
product_code = InputBox("Product Code")
For k = 3 To LRow
If Cells(k, 8) > AverageStock(product_code) Then
I only have this till now, any help/suggestions?
MsgBox will only contain text and a title:
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/msgbox-function
The option you have is to create a custom UserForm.
I have three columns E(insufficient QTY) F(Too Slow) and G(Not Listed) They all have checkboxes in them. I need to link
E to H
F to I
G to J
The following code works nicely if there was only 1 column of checkboxes but I don't know how to improve the code to run by checkboxes in a certain column. Right now it just searches the entire sheet for checkboxes and links them to the desired column.
Sub LinkChecks()
'Update 20150310
i = 2
For Each cb In ActiveSheet.CheckBoxes
cb.LinkedCell = Cells(i, "I").Address
i = i + 1
Next cb
End Sub
Edit
Ok... let's try again:
Since the Check Box object does not have cell information for the cell it's located in, we will have to use the Offset property more creatively.
Since we know there are 3 check boxes per row, we can find the total number of check boxes and divide by 3 to find out how many rows there are.
Then by setting a Range to a single cell at the top of column "E", you can use the offset property on that cell.
Assuming you placed your Check Boxes on the sheet down column "E" sequentially, and then down column "F" next, then down "G", we can reset the offsets once we get to the last row of each column. (If you place the check boxes on the sheet in row order, you'll have to invert the loop logic.) (If you placed the check boxes on randomly, you are out of luck and will have to set your linked cells manually.)
Sub LinkChecks()
Dim rng As Range
Dim strColumn As String
Dim i As Integer
Dim intCount As Integer
Dim intRowCnt As Integer
Dim intRowOffset As Integer
Dim intColumnOffset As Integer
Dim dCnt As Double
i = 1 ' Your initial row offset
intCount = 0 ' A counter for total number of check boxes
intRowCnt = 0 ' A Row counter to find last row
intRowOffset = i ' Current Row offset from initial rng cell
intColumnOffset = 3 ' Current Column Offset (3 over from first check box column)
strColumn = "E" ' Set a starting Column of your first check box
Set rng = ActiveSheet.Cells(1, strColumn) ' Set initial rng cell
' Count how many check boxes are on the active sheet
For Each cb In ActiveSheet.CheckBoxes
intCount = intCount + 1
Next cb
' Since you know you have 3 check boxes per row,
' you can divide by 3 to get your row count
dCnt = intCount / 3
' *** Put test for remainder problems here ***
For Each cb In ActiveSheet.CheckBoxes
cb.LinkedCell = rng.Offset(intRowOffset, intColumnOffset).Address
intRowOffset = intRowOffset + 1
' Increment your row count until you get to last row
intRowCnt = intRowCnt + 1
If intRowCnt >= dCnt Then
intRowCnt = 0 ' Reset you row counter
intColumnOffset = intColumnOffset + 1 ' Increment Offset to the next column
intRowOffset = i ' Reset Row offset back to top row
End If
Next cb
End Sub
As long as your check boxes were placed on the sheet down each column, the above program should find the correct Linked Cell for each box.
If they were placed in a different order, then at least this code shows you how to set an initial Range cell and how you can reference other cells with an offset.
Hopefully this code or a combination of these ideas will help you with your problem. :)
I am trying to generate a list of data based on the contents of a group of filtered cells. First (in code not included), users select a criterion from a list box, which filters a list of 800 accounts down to the number that meet that criterion. From there, I need to grab the value from Column a and the row that corresponds to the visible cells. The issue is that I can't do a straight reference to the row, because when the rows are hidden, it is no longer a 1,2,3,4 etc sequential list. Here is the code I have, I know exactly where I need to specify the rows, just not how to do so
Sub AllProviders_Click()
Dim i As Integer
Dim vCount As Integer
vCount = Range("E18:E817").SpecialCells(xlCellTypeVisible).Count
MsgBox vCount 'for debugging
For i = 1 To vCount
Sheets("Provider Output").Cells(3, 2 + i) = 'and this is where I have no idea
Next i
End Sub
When the sub is run, the number of cells that are visible is stored in vCount, which is used to specify how many columns of data are going to be filled. My issue is line 7, where I need to specify the cells to pull.
Try:
Range("A18:A817").SpecialCells(xlCellTypeVisible).Copy _
Sheets("Provider Output").Cells(3, 3)
Edit: if that's not working for you then maybe try this -
Sub AllProviders_Click()
Dim i As Integer
Dim c As Range
i = 1
For Each c In Range("E18:E817").Cells
If Not c.EntireRow.Hidden Then
Sheets("Provider Output").Cells(3, 2 + i) = c.EntireRow.Cells(1).Value
i = i + 1
End If
Next c
End Sub
I am looking for some help with excel Macros eg. If a value is found in Desc that matches Bill/car/rent/tax the Cost value copied to the correct column.
Cost Desc Bill Car Rent Tax
155 Bill
165 Rent
195 tax
Cost Desc Bill Car Rent Tax
155 Bill 155
165 Rent 165
195 tax 195
Can this be done?
Thanks in advance. I have attempted and can select the value but not sure how to paste it etc, not very good with vba macros.
Thanks for the replies. sorry I am still confused just learning stuff atm. this is what I got maybe its not the correct way to go about doing it.
Sub Test()
For Each Cell In Sheets(1).Range("B:B")
If Cell.Value = "Bill" Then
matchRow = Cell.Row
Rows(matchRow - 1).Select
Selection.Copy
End If
Next
End Sub
If your columns are fixed, you could loop through the "Desc" column and then copy set the values of the other columns to the value of column "Cost".
Sub SortMyColumns()
Dim lastRow As Long
Dim i As Long
Dim costColumn As Integer
Dim descColumn As Integer
Dim billColumn As Integer
Dim carColumn As Integer
Dim rentColumn As Integer
Dim taxColumn As Integer
'Change values according to columns
costColumn = 1
descColumn = 2
billColumn = 3
carColumn = 4
rentColumn = 5
taxColumn = 6
lastRow = Worksheets(1).Cells(Rows.Count, descColumn).End(xlUp).Row
'Loop through the "Desc" column and check values
For i = 1 To lastRow
If Worksheets(1).Cells(i, descColumn).Value = "Bill" Then
Worksheets(1).Cells(i, billColumn).Value = _
Worksheets(1).Cells(i, costColumn).Value
End If
Next i
End Sub
This only works if your columns always stay the same.
VLOOKUP shouldn't work because the columns are in the wrong order. Cost should come after Desc for VLOOKUP to work. VLOOKUP cannot look to the left.
It seems that you have a sub to find the value (vlookup/match) but not sure how to get that value into the worksheet?
to check or do something if a cell has a value
you can do it by checking if a cell is empty, if true do this, if false do that.
With worksheets("name")
if .range("A1") = empty then
do something (for example, Application.WorksheetFunction.VLookup() )
else
do something else ("exit sub" if you want it to do nothing)
end with
To store a value and to place it somewhere into an active sheet
dim i (this doesn't have to be "i") as string
i = your function
worksheets("name").range("A2").value = i