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.
Related
I have what I thought was a very basic VBA challenge, and have spent hours searching for an answer. Thanks if someone can point me to the right place if already addressed.
I have a formula that is B1 + C1 = D1, and have two 1x5 matrix of data inputs, one for cell B1 and one for cell C1, say [1,2,3,4,5] and [A,B,C,D,E], respectively, in cells (B2:B7) and (C2:C7). I would like to loop through the inputs, such that I get five unique answers [1+A, 2+B, 3+C, 4+D, 5+E], and output those answers in an adjacent 1x5 matrix, say in cells (D2:D7).
Recording a macro does not work here, as it records a copy/paste action that is inflexible for future use (for expanded matrices, other sheet locations, more complex formulas, etc).
Any help much appreciated.
Henry
UPDATE: I believe I need to be using "Do While" or some similar loop code, and additional "For" and "Next" coding.
UPDATE: Here is a step-by-step picture of what I am trying to do with the code:
step-by-step process results image
Here's the solution code:
Sub IterationMacro()
'Declare Variables
Dim h, i, j, k As Integer
Dim mySheet As Worksheet
Dim myAnswer As String
'Set Worksheet
Set mySheet = ActiveSheet
'Set # of Iterations
h = Range("B2").Value
'Clear Previous Contents
Range("C4:D4").ClearContents
Range("e5:e11").ClearContents
'Run Through Loops
For i = 5 To h + 4
For j = 3 To 4
mySheet.Cells(4, j).Value = mySheet.Cells(i, j).Value
Next
'Calculate Workbook
Calculate
mySheet.Cells(i, 5).Value = mySheet.Cells(4, 5).Value
Next
End Sub
If you could draw a table or something to use as an example, it might help.
Assuming I'm undersatnding you, you want to use a formula in D1, and fill down to D7, resulting in showing B+C=D in each row:
Range("D1").Formula="=B1+C1"
Range("D1:D7").Filldown
Edit:
Having been given the example image, it looks like you want math to happen in Row 2 (headers in Row 1). In Row 2 you want to pull up values from Row "i" and add them in Row 2, then paste the answer of that sum in Row "i".
Dim i as Integer 'i is the variable for the loop
For i = 3 to 9 'based on the picture, 3 to 9 are the 1 through 7 values
Cells(2,1).Value=Cells(i,1).Value 'pulls up Column A value from the loop to Row 2
Cells(2,2).Value=Cells(i,2).Value 'pulls up Column B value from the loop to Row 2
Cells(2,3).Formula="=A2+B2" 'Sums A2 and B2 into C2
Cells(2,3).Copy Cells(i,3) 'Copies the summed value to Row "i" in Column C
Next i 'Moves to next "i" in the loop
Let me know if that is more to your point.
Edit:
With dynamic ranges, you still know your starting point. You would look at something similar to:
Dim i as Integer
Dim LR as Long
Dim LC as Long
LR=Cells(Rows.Count,"A").End(xlUp).Row
LC=Cells(1,Columns.Count).End(xlToLeft).Column
For i = 3 to LR 'Still starting at 3, because of the example
Cells(2,1).Value=Cells(i,1).Value
Cells(2,2).Value=Cells(i,2).Value
Cells(2,LC+1).Formula="=A2+B2" 'Note the LC+1 goes one row BEYOND the last column
Cells(2,3).Copy Cells(i,LC+1)
Next i
In the last example, you can see syntax for dynamic ranges. Note that LR and LC are defined outside of the loop and do not change for the duration of the subroutine.
I am putting together some VBA code which i think needs a loop. Loops are often my biggest weakness with VBA and I need some assistance.
I have a text file which i import into an excel spreadsheet. The length of how many columns and rows and down will vary day to day.
For example today's file might have data in columns A - H, tomorrow it might be A : P. Each typical row count will be around the 200 mark, so not to long.
In essence im trying to make one long list in column A from all the data spread over multiple columns.
Im looking for a loop that checks if the column has data in it, if it does it then copies the data into the bottom of the data in column A.
So for illustration purposes say the data goes out to column G, it will copy B1, xl down, find the first empty row in A and paste, then do the same for C, stopping after column G.
I hope I’ve been clear when writing this.
Thanks in advance
Matt
You first want to loop over all columns. So a FOR loop from column B to LastColumn (which there is a function for.) Then you want to loop through all rows within that column to find the first empty row, and then substract one to arrive at the last column with data.
If Cells(row,col) = "" Then
LastRowCopy = row -1
Then you want to copy everything to A1, and keep track of the last row you posted in. So you want to have a variable that counts. Something like:
LastRowPaste = LastRowPaste + row
I could write the code for it, but perhaps you learn more by figuring it out yourself.
Edit: Also perhaps an interesting read on finding last rows and or columns is this: http://www.rondebruin.nl/win/s9/win005.htm
Edit2: You could ofcourse also use the same for finding the last column as the method I used for finding the last row. Then you just loop through the columns and see if:
If Cells(1, col) = "" Then
LastCol = col -1
Edit3:
I wrote out the entire code:
Sub copypaste()
Dim LastRowCopy As String
Dim LastRowPaste As String
Dim LastCol As String
Dim col As Integer
Dim row As Integer
LastCol = ActiveSheet.UsedRange.Columns.Count
LastRowCopy = ActiveSheet.UsedRange.Rows.Count
LastRowPaste = ActiveSheet.UsedRange.Rows.Count
For row = 1 to LastRowPaste
If Cells(row, 1) = "" Then
LastRowPaste = row
Exit For
End if
Next row
For col = 2 To LastCol
If Application.WorksheetFunction.CountA(Columns(col)) = 0 Then
LastCol = col -1
End If
Next col
For col = 2 To LastCol
For row = 1 To LastRowCopy
If Not Cells(row, col) = "" Then
Cells(LastRowPaste, 1) = Cells(row, col)
LastRowPaste = LastRowPaste + 1
End If
Next row
Next col
End Sub
I have looked at a bunch of questions like this, but I have only found formulas, and VB examples that don't appear to check the values of cells in a column.
I was able to derive the following formula in Excel:
=IF(AND(ISNUMBER(SEARCH("Cat",R2)),OR(ISNUMBER(SEARCH("5E",R2)),ISNUMBER(SEARCH("6",R2))), ISNUMBER(SEARCH("Patch",R2)), ISNUMBER(SEARCH("Cables",R2))), "CAT 5E Ethernet Cables")
The problem is that this formula only checks for 1 out of 500 possible values. This is not productive. Plus, I have to make it one big formula when I check the entire row, because if I don't, the formula overwrites the result of the previous formula...
So, Visual Basic... I think I may have better luck scripting some kind of IF ELSE or CASE statement. I just do not understand how to do this in excel. I need to achieve the same thing as the formula above, but instead of checking for one set of conditions,
I need to check for multiple, and populate the S & T columns based on the result of each set of conditions.
I found this webpage that just mentions Excel and shows a VB IF - ELSE statement. How can I make this statement check Excel columns?
I tried the selected answer in this post with no luck:
Private Sub UpdateCategories()
Dim x As Long
For x = 1 To 5000
If InStr(1, Sheet1.Range("$B$" & x), "cat") > 0 And InStr(1, Sheet1.Range("$B$" & x), "5e") > 0 Then
Sheet1.Range("$T$" & x) = Sheet1.Range("$T$" & x) & "CAT 5E Ethernet Cables (Test)"
End If
Next
End Sub
Any help is appreciated. Thanks in advance!
Assuming you choose the route of using a data table sheet to compare to your string.
You would need to have a sheet looking like this (Maybe this is not what you want because I didn't thoroughly understand how your data looks like but the idea remains). You could have sub-category if you want, as well as category, in a third column.
column A | column B
keyword |category
CAT |ATX Cases
5e |Mini-ITX Cases
important words |MicroATX Cases
...
This would need to be filled manually. I'm not sure about the amount of data you're looking at. It can be pretty rapid if you can copy/paste stuff efficiently, depending on the form of your data.
When you have that, loop using this code. I assume the data table is in Sheet1, columns A and B and the values are in Sheet2, column A.
dim listLength as integer 'number of values to look at
dim i as integer
dim dataLength as integer 'number of keywords
dim j as integer
dim keyword as string
dim value as string
listlength = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row - 1 'assuming you start on row 2
datalength = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1 'assuming you start on row 2
for i = 2 to listLength + 1
value = Sheet2.Range("A")(i)
for j = 2 to dataLength + 1
keyword = Sheet1.Range("A")(j)
if instr(value, keyword) <> 0 then
' what happens when the keyword is present goes here
end if
next j
next i
I have been doing some basic VBA programming in Excel 2010 but I have been struggling with this challenge for some time. Basically, I have a sheet that is formatted like this (It actually has 62 columns and rows=# of days in the given month):
Column A will be hidden but is used in a few formulas.
Row 15 shows whether or not the station is open 24/7(all) or only Monday-Friday(M-F).
the values presented are arbitrary counts. However, a blank count represents a problem unless... the station is M-F and
I need to get my code to identify a station that is open M-F and then fill in any particular Sat. or Sun (for that station) with the word "closed." then search for the next station that is M-F and repeat the process.
Initially I was having my code start with an actual value and then use several activecell.offset functions to find empty cells and then check conditions but I couldn't get it to work out. Then I tried to check from the station name or the schedule row but I couldn't get the multiple if/nested offset statements to work either.
I would really appreciate any help or insight you could provide that would show me the best approach. I don't really need the code that does it I just need a pseudo code walk-through unless you are kind enough to write out the code.
Thanks for your help!
I had a similar problem I worked out before. I modified it to your spreadsheet:
Dim d As Long, s As Long
d = 1 'weekdays column
s = 40 'status row
Dim r As Long, c As Long
r = ActiveSheet.Cells(Rows.Count, d).End(xlUp).Row
c = ActiveSheet.Cells(s, Columns.Count).End(xlToLeft).Column
Dim i As Long, cell As Range
i = 0
Dim days() As Long
For Each cell In Range(Cells(1, d), Cells(r, d))
If cell.Value = "Sat" Or cell.Value = "Sun" Then
ReDim Preserve days(i)
days(i) = cell.Row
i = i + 1
End If
Next cell
For Each cell In Range(Cells(s, 1), Cells(s, c))
If cell.Value = "M-F" Then
For i = LBound(days) To UBound(days)
Cells(days(i), cell.Column).Value = "closed"
Next i
End If
Next cell
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