I have a simple loop I want to use to cut and paste cells under conditions from one sheet to another one.
Dim i, b As Long
For b=1 To 18 Step 2
For i = 5 To 21
INTP = Sheets("Feuil1").Cells(i, 18+b)
client = Sheets("Feuil1").Cells(i, 17+b)
If IsNumeric(INTP) Then
Sheets("Feuil2").Columns(b).End(xlDown).Offset(1, 0) = client
End If
Next i
Next b
With that code the problem is that only the value when i=21 will be paste in my next sheet (Feuil2). Nothing happen for the other values ...
I cannot figure what I am missing, thanks
it looks like you are overwriting the values on top of each other, therefore only showing the last one (21).
Try replacing
Sheets("Feuil2").Columns(b).End(xlDown).Offset(1, 0) = client
with
Sheets("Feuil2").cells(frow,2)=client
frow=frow+1
and add
dim frow as integer
frow=1 '' or the first empty row in your list
to top of your sub
Related
I have an issue I'm unable to resolve myself and was wondering if anyone here could help me. I have table with a lot of values which are broken down into different sections (separated by an empty row). I need to be able to control where a new row is inserted with the use of a macro.
What I would like to do is to create a macro with conditions so that I can control where an empty row are to be inserted. My take is to create separate buttons next to each sections (before an empty row) that assigns a value so that loop may skip through x number of empty rows before inserting a new row. My first take is like this:
Sub InsertNewRow()
Dim erow As Integer
Dim number As Integer 'number of empty rows to skip
Dim count As Integer 'to keep track on number of empty rows to skip
Dim LastRow As Long
erow = ActivityInput.UsedRange.Rows.count
count = 0
For Each l In erow
Do While i <> ""
Next erow
count = count + 1
If element = count Then
'Cells(Rows.count, 1).End(xlUp).Offset(1, 0).EntireRow.Insert
'This is as far as I got. I don't know how to make the macro go to the last row of the current section... any suggestions?
..
To clarify, I would like to add macro(s) (bottons) that helps the user to insert new rows. If the user is at section 3 (2 empty rows have been passed which separates the different sections), I would like the user to be able to click on the macro (button) which then subsequently adds a new row to the current section.
Any ideas?:/
Regards,
Alexander
Sub InsertNewRow(X As Integer)
Dim count As Integer
count = 0
For i = 1 To ActivityInput.Range("X[ABC]")(i)
If i <> "" Then Next i
ElseIf X = count Then
Cells(l, 1).End(xlDown).Offset(1, 0).EntireRow.Insert
Else
count = count + 1
Next l
End Sub
I am trying (using VB) to copy 7 values from 1 location to another.
(copy from F115 to F134.)
(F115 is source of numbers; F134 is destination for numbers)
If there is data (any data) in F134 I want to advance the row by 1 and then print/copy. I do not want to overwrite any lines of data.
So, if there is data in the first row (F134) then I want to move/advance the row count by 1 and then copy the values into row F135 - and so on. It's possible that there could be 500 to 100 rows of numbers and I need to be able to view all of this data.
So far, this is the code I have: some works, but it does NOT advance the row count and continues to print into Cell F134. (oh yes, F124 is just a set of empty cells.)
Ok, this is my code;
Sub dbtest4()
Dim RowCounter As Integer
rowCounter = 1
Do Until rowCounter = rowCounter +1
'trying to advance the row counter by 1 such that if there is data in F134, the line count will advance and the new data will print into the NEXT line. (which would be F135)
'the following code probably is unnecessary, but I'm trying anything...
'actually the following code works ok: Range("F134").Resize(1,7).Value = Range("F115").Resize(1,7).Value, but that's about it.
If Range ("F134") = 0 then
Range("F134").Resize(1,7).Value = Range("F115").Resize(1,7).Value
'trying to print data cells from F124 if there is no data in F134
Else
Range("F134"),Resize(1,7).Value = Range("F124).Resize(1,7).Value
'trying to print the zeros or blank numbers from F115 if F134 has data in it
End if
Loop
Exit Do
End Sub
Thanks to anyone who may be able to offer some assistance.
So right now the exit condition for the Do While loop is that rowCounter has to increment by one. I can't see a reason why this should fail and that is why it is only happening once. Here is some psuedocode:
Do Until copiedVals = 7 'Or whatever exit value you want
If row.Value.Exists() then
'There is a value in this row, so increment the row count
rowCounter = rowCounter + 1
Else
'This row is empty and you can do your thing
'rowCounter will have the current row value
copiedVals = copiedVals + 1
End If
End Loop
I have an excel file which has column B1 to B500 (may vary) filled with numbers. For example:
I need the output to be like:
I have this much code till now:
Sub Max()
Dim i As Long, j As Long
Dim cl As Excel.Range
i = 1
j = 1
For i = sheet.UsedRange.Rows.Count To 1 Step -1
cl = sheet.Cells(i, 2) '## Examine the cell in Column B
If xl.WorksheetFunction.CountIf(sheet.Range("B:B"), cl.Value) > 1 Then
cl.Value = sheet.Cells(j, 3).value 'copy to Column C
End If
j = j + 1
Next i
End Sub
What this code does is to find duplicates in column B and remove other entries from the column. Nothing gets written in column C. I want the column B to be unedited at the end. Also cannot figure out how to achieve the sorting here.
Please help.
Well, you could use formulas if you want too:
It is very important to use array formulas (Ctrl+Shift+Enter when done editing the cell), my Excel is an Spanish Version, so you just need to change:
- SI by IF
- CONTAR.SI by COUNT.IF
I came up with this solution thinking about the bubble sort algorithm. I hope this will be useful for you.
Hi I am using VB to populate data in excel. In the sheet, the column G has many cells with same numbers(and they are repeated without following any pattern). First I would like to find which entries are not unique and then keep the first occurrence in the column & delete the entire rows where repetitions are encountered. Here's an example:
As can be seen from the image, in the column G, numbers 1000 & 2200 are repeated. So need to delete entire rows 3 and 6 (keeping rows 1 & 2 where 1000 & 2200 appear first).
Here's the code which I can't get to work:
Sub Dupli()
Dim i As Long, dic As Object, v As Object
dic = CreateObject("Scripting.Dictionary")
i = 1
For Each v In sheet.UsedRange.Rows
If dic.exists(v) Then sheet.Rows(v).EntireRow.Delete() Else dic.Add(v, i)
i = i + 1
Next v
End Sub
Try something like this. I don't think you need a dictionary (unless there is some other need for it elsewhere in your code). When deleting objects, it's usually necessary to iterate backwards over the collection. This method just uses the CountIf function to test whether the cell value in column G of a specific row occurs more than once in all of column G, and deletes the row if that condition is true.
Sub Dupli()
Dim i As Long
Dim cl as Range
i = 1
For i= sheet.UsedRange.Rows.Count to 1 Step -1
Set cl = sheet.Cells(i,7) '## Examine the cell in Column G
If Application.WorksheetFunction.CountIf(sheet.Range("G:G"),cl.Value) > 1 Then
sheet.Rows(i).EntireRow.Delete
Next
End Sub
Put this in H1:
=COUNTIF(G$1:G1;G1)
Fill down to end
Make an autofilter on column G
Filter out values of 1
Select the remaining rows by row header
Right click on row header > click Delete ...
I have a little problem, I occasionally bump into this kind of problem, but I haven’t found a fast solution so far.
So, imagine we have an Excel worksheet and let's suppose that we have a couple of numbers in column ’A’ with some empty cells in it. Altogether (just to make it simple) we have the first 10 cells in column 'A' to observe. For example:
3
(empty cell)
(empty cell)
6
(empty cell)
4
(empty cell)
23
(empty cell)
2
Now in the next step I would like to collect these numbers into another column (for example, column ’B’) using VBA. Obviously I just want to collect those cells which contain a number and I want to ignore the empty cells. So I would like to get a column something like this:
3
6
4
23
2
I have already written the following code, but I’m stuck at this point.
Sub collect()
For i = 1 To 10
if cells(i,1)<>"" then...
Next i
End Sub
Is there an easy way to solve this problem?
Probably the quickest and easiest way is to use Excel's Advanced Filter - the only amendment you'll need to make is it add a field name and criteria. You can even list unique items only:
The VBA equivalent is
Sub test()
With Sheet1
.Range("B1:B8").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"D1:D2"), CopyToRange:=.Range("F1"), Unique:=False
End With
End Sub
You should be able to use the method in the post int the comments, but you could also use SpecialCells like Range("A:A").SpecialCells(xlCellTypeConstants,xlNumbers).Copy to get all of the filled cells.
Edit: needed constants not formulas.
This will work for any number of rows that you select. It will always output in the next column at the start of your selection e.g. if data starts in B10 it will ooutput in C10
Sub RemoveBlanks()
Dim cl As Range, cnt As Long
cnt = 0
For Each cl In Selection
If Not cl = vbNullString Then
Cells(Selection.Cells(1, 1).Row, Selection.Cells(1, 1).Column).Offset(cnt, 1) = cl
cnt = cnt + 1
End If
Next cl
End Sub
If you wish to loop manually and don't mind specifying the maximum row limit;
Dim i As long, values As long
For i = 1 To 10
If cells(i, 1).Value <> "" Then
values = (values + 1)
' // Adjacent column target
cells(values, 2).value = cells(i, 1).value
End If
Next i