Excel VBA: How to convert numbers to ranges - vba

I have some numbers and I want to list their ranges
0O6X6768
0O6X6769
0O6X7468
0O6X7469
0O6X7470
0O6X7477
0O6X7478
0O6X7479
0O6X7482
0O6X9383
Like these, I want to turn them into
0O6X6768 0O6X6769 0O6X7468~0O6X7470 0O6X7477~0O6X7479 0O6X7482 0O6X9383
The first three characters will be the same, but the third to fourth characters will change, so I wrote a judgment
IsNumeric(Right(Cells(i, "A"), 4))
If TRUE then
CInt(Right(Cells(i, "A"), 4))
If Flase then
CInt(Right(Cells(i, "A"), 3))
convert them to numbers and then subtract the next cell from this one to determine if it is 1
But this way
0O6X6768 0O6X6769
will become
0O6X6768~0O6X6769
I think there should be a better solution, how should I do it?
Here are some examples
examples.xlsx download
Thank you all.

Related

VBA Lopping through a Union with non-contiguous ranges

I'm creating a report where I'm looking at a date column, and based on the value in that column (falling between a range), I increment an aggregate with the value in the previous cell. Because the dates are in non-contiguous columns, I'm using a Union range. I've hard coded the cell values below and deleted the rest of the code to hone in on the looping issue. My loop goes through 5 times, but each time the values $I$2 and the same date value appears. How can I get my loop to go to cell K2 and beyond?
Dim c as Range
Range("I2").Select
Set installmentRng = Union(Cells(2, 9), Cells(2, 11), Cells(2, 13), Cells(2, 15), Cells(2, 17))
For Each c In installmentRng
MsgBox (ActiveCell.Value)
MsgBox (ActiveCell.Address)
Next c
If you replace the ActiveCell.Value with c.Value, I think your problem is solved.
You shouldn't use Select at all, if possible. Also, if you replace Msgbox with Debug.Print, your troubleshooting will be a lot less painful. Press Ctrl+G to see the output.
ActiveCell is the cell where the focus is on (with other words, if the user starts to type something, it will go into this cell).
While working on worksheet data in VBA, you usually don't need to deal with the ActiveCell. In your case, the loop is not changing the ActiveCell (and there is no need to do so ). Instead, the Range-Variable c will change, and you can work with that:
For Each c In installmentRng
MsgBox c.Value
MsgBox c.Address
Next c
Two additionally remarks:
(1) no need for the Range("I2").Select - statement. This changes the ActiveCell - but as said, this is not necessary (you need the Select-statement nearly never, but it's often seen in (bad) VBA-code because the macro-recorder uses it.
(2) Do not put parenthesises around the msgBox parameter.

Find cell value, match, cut, move, ...vba

I am a beginner in VBA.
I have components which always consist from 2 parts. (Rotor and a stator, each has its own number). When work is with them it can be damaging some of these parts, however it is necessary to keep a list of damaged parts, where the result is inventory e.g. 200 rotors, stators 150 with different numbers. Before I could scrap it, I need to complete them as proper sets. I.e. rotor "a" stator "a", "b" with "b", etc. It's crazy to work with many numbers to compare them, copy …to find the result of sets qty.
It is possible to solve it with Macro, what I try to do, but I was stuck.
What is the task: In the column "A" I have a list of all damaged parts (mix of rotors, stators different numbers). In the column "C" an information only with help of VlookUP, what should be a counterpart number.
What do I need to solve: In row 5, column. „A“ I have component number , but I know that in the same column, somewhere from row 6 to xx I have a counterpart. What I need is … according to information from column C, same row(5) where is info about the counterpart num. to find counerpart in column A, when found, took it out and put into cell B5. Thus,I get a complete set. Then the next row (6), same action. Macro reading num. in „C“,searching in „A“, when found, cut, and put to „B“ next row 7,8,9,… The result should be a certain qty of pairs + some single numbers if not second part found.
The problem I have is that cycle is working until always found relared counterpart. If the counterpart in row A is not available (no match betwen C-A), the code will stop on that row.
What I need help with is, that if code did not find the counerpart based to info from C just skip this row, make it red and continue with next row till end, it means stop on first empty cell in C. Thanks a lot to everybody who is helping me.
Dim pn As Range,
Dim a
Dim x
x = 5
Dim i As Long, Dim radek As Long
a = Cells(x, 3)
For i = 1 To 500
Range("A:A").Select
Set pn = Selection.Find(What:=a)
If Not pn Is Nothing Then
pn.Select
End If
Selection.Cut
Cells(x, 2).Select
ActiveSheet.Paste
x = x + 1
Next
End Sub

Merge values in multiple columns into one

I have the following data structure:
As you see in column J, I am trying to merge data into one column from columns A & C & E & G.
I am using this formula:
=IF(ROW()<=COUNTA($A:$A);INDEX($A:$C;ROW();COLUMN(A1));INDEX($A:$C;ROW()-COUNTA($A:$A)+1;COLUMN(C1)))
and I get the values in column K as you see. Currently this formula is merging only two columns. How to modify it to merge all four columns?
And how to only get those values starting from row 5?
The column height will vary constantly: sometimes there are 10 values in column A and sometimes there are 2 values.
Either any excel formula or any VBA code will be acceptable.
There is a fairly standard method for retrieving unique values from a column but not multiple columns. To achieve the retrieval from multiple columns you need to stack multiple formulas together with the processing being passed to successive columns one the earlier formula errors out.
      
The array formula¹ in J5 is,
=IFERROR(INDEX($A$5:$A$99, MATCH(0, IF(LEN($A$5:$A$99), COUNTIF(J$4:J4, $A$5:$A$99), 1), 0)),
IFERROR(INDEX($C$5:$C$99, MATCH(0, IF(LEN($C$5:$C$99), COUNTIF(J$4:J4, $C$5:$C$99), 1), 0)),
IFERROR(INDEX($E$5:$E$99, MATCH(0, IF(LEN($E$5:$E$99), COUNTIF(J$4:J4, $E$5:$E$99), 1), 0)),
IFERROR(INDEX($G$5:$G$99, MATCH(0, IF(LEN($G$5:$G$99), COUNTIF(J$4:J4, $G$5:$G$99), 1), 0)),
""))))
I have only included columns A, C, E and G as your sample data shows only duplicates in columns B, D, F, and H.
¹ Array formulas need to be finalized with Ctrl+Shift+Enter↵. If entered correctly, Excel with wrap the formula in braces (e.g. { and }). You do not type the braces in yourself. Once entered into the first cell correctly, they can be filled or copied down or right just like any other formula. Try and reduce your full-column references to ranges more closely representing the extents of your actual data. Array formulas chew up calculation cycles logarithmically so it is good practise to narrow the referenced ranges to a minimum. See Guidelines and examples of array formulas for more information.
This answer is another way of thinking about the formulas you could use for this sort of task. It gets to the point made by #Jeeped that it is difficult to find unique values in multiple columns. My first step then is to create a single column.
If you can live with a helper column, these formulas might be a tad easier to maintain than the nested IFERROR already proposed. They are equally difficult to understand though at first glance. The other upside is that it scales nicely if the number of columns involved increases.
It is possible using CHOOSE and some INDEX math to build a single column array of a group of separated columns. The trick is that CHOOSE will join discontinuous ranges side-by-side when given an array as the selecting parameter. If this starts with columns of the same size, you can then use division and mod math to turn it into a single column.
Picture of ranges shows the four groups of data with duplicates colored red.
Formula in F2:F31 is an array formula. This is combining all of the columns into an array and then back into a single column. I selected the columns out of order just to emphasize that it is handling a discontinuous range.
=INDEX(CHOOSE({1,2,3,4}, A2:A7,C2:C7,B2:B7,D2:D7), MOD(ROW(1:30)-1, ROWS(A2:A7))+1,INT((ROW(1:30)-1)/ROWS(A2:A7))+1)
The array formula in H2 and copied down is then the standard formula for unique values. The one exception is that instead of avoiding blanks like normal, I am avoiding 0 values.
=IFERROR(INDEX(F2:F31,MATCH(0,IF(F2:F31=0,1,COUNTIF($H$1:H1,F2:F31)),0)),"")
A couple of other comments about this approach:
In the CHOOSE, I am using {1,2,3,4}. This could be replaced with TRANSPOSE(ROWS(1:4)) or whatever number of columns you have.
There is also a ROWS(A2:A7) in 2 places, this could just be 2:7 or 1:6 or whatever size was used for the column size. I used one of the data ranges so that the coloring was simplified and to emphasize it needs to match the size of the block.
And the ROW(1:30) is used for the number of total items to collect. It really only needs to be 1:24 since there are 6*4 items, but I made it big while testing.
There are definitely a couple of downsides to this approach, but it may be a good trick to keep in the toolbox. Never know when you might want to make a column out of discontinuous ranges. The largest downside is that the columns of data all need to be the same size (and of course the helper column).
This code will do what you ask:
Sub MoveData()
START_ROW = 5
START_COL = 1
STEP_COL = 2
OUTPUT_ROW = 5
OUTPUT_COL = 10
Row = START_ROW
Col = START_COL
Out_Row = OUTPUT_ROW
While Col < OUTPUT_COL
While Cells(Row, Col).Value <> ""
Cells(Out_Row, OUTPUT_COL).Value = Cells(Row, Col).Value
Out_Row = Out_Row + 1
Row = Row + 1
Wend
Row = START_ROW
Col = Col + STEP_COL
Wend
End Sub
Think you guys are making this complicated. Just pull the range of data into power query , select all the columns and unpivot them this will bring all the data into a single column

VBA - draw in numbers from one sheet and get data from another

I am trying to write a VBA to draw data from one sheet to another, but am stuck on something.
I only need some of the data in the original sheet (let's call it s1), in particular, I need data between two rows.
I have these rows written down in another sheet (s2), so I know exactly between which rows I need the data from. As you may expect there are multiple rows between which I need the data.
The problem is now that I am trying to write a VBA that is able to look up these rows in my row sheet (s2), and then goes to the sheet in which all my original data is contained (s1), and then draws out the data between the two rows into a third sheet (s3).
I have not been able to make it draw in the numbers from s2 (can't seem to work out how to tell it that it is these two rows between which I need the data, but from another sheet), and currently have to input the row numbers myself, which is really tedious, since the dataset is large!
Any help would be much appreciated!
Thank you!
Have you tried the .find option.
You could use something like this:
findrow = w1.Cells.Find(what:="Content", MatchCase:=False).Row
An more extensive example would help
Just break down your problem into smaller steps.
You can assign a value on a sheet using cell references:
Sheets("S1").Cells(iRow, iCol) = Value
'or
Sheets("S3").Cells(2, 10) = Sheets("S2").Cells(2, 10)
You can use Sheets("S1").Range("J" & iRow) or Range("J2").
If there are conditions that need to be met for something to happen, use If statements.
If (Value 1 < Value 2) Then
Sheets("S3").Cells(2, 10) = Sheets("S2").Cells(2, 10)
Else
Sheets("S3").Cells(2, 10) = Sheets("S1").Cells(2, 10)
End If
Without more information about the specific choices you are using to determine which rows to copy and from which sheet, it's hard to say. But you can do things in smaller batches or copy whole ranges, by looping.
Dim iRow As Integer
'This would copy all the data from Sheet("S1").Range("J1:J20) to Sheet "S3".
For iRow = 1 to 20
Sheets("S3").Cells(iRow, 10) = Sheets("S1").Cells(iRow, 10)
Next iRow
You could insert an If statement into each row, inside the loop to see if a certain criteria is met, and then decide which sheet in which to copy the data.

VBA - Copy Formatting of Range to Array

I'm creating a report with multiple columns. What I need is that the columns that show only whole numbers, no decimals, should be rounded to the whole number (so that it not only shows a rounded number, it actually equals a round number). The columns that show the numbers with two numbers after the decimal should not be rounded.
What I can do is:
If c.NumberFormat = "#,##0_);(#,##0)" Then
c.Formula = "=round(" & Right(strFormula, Len(strFormula) - 1) & ",0)"
End If
However, I have the entire report in an array, and I would like to just paste the whole array into the sheet rather than pasting one cell at a time. I would also rather not process and round each cell based on the cell formatting, rather I would like to copy the formatting of the range where the report will go into an array, and work from the array. I believe this will cut a few seconds off the process.
Is there a way to copy the formatting of a range into an array?
Is there a way to copy the formatting of a range into an array?
Focusing on the question as posed, yes, that can be done. Unfortunately, it can't done in a one-liner, in the way that a range's values can be assigned to an array with myArray = Range("A2:F25"), for example. (See, also, brettdj's comment.) Instead, you'd need something like:
Dim rng as Range
Dim formatArray() As String
Dim i as Long, j as Long
Set rng = Range(A2:F20) 'or whatever the range is
Redim formatArray(1 to rng.Rows.Count, 1 to rng.Columns.Count)
For i = 1 to rng.Rows.Count
For j = 1 to rng.Columns.Count
formatArray(i, j) = rng.Cells(i, j).NumberFormat
Next
Next
...
A couple of observations, though:
You actually only need to know the formatting for a single row of the range since, presumably, the number formatting in a column will not change mid-column.
That would simplify the code to:
...
Redim formatArray(1 to rng.Columns.Count)
For i = 1 to rng.Columns.Count
formatArray(i) = rng.Cells(1, i).NumberFormat
Next
...
assuming, for sake of example, that row 1 of the range has the necessary number formats.
I am curious why you would want to modify a formula on the worksheet so that it will round, since you could presumably do the calculation in your code, with rounding, and then write the resulting value back to the sheet for your report.
If you need to apply number formats to the values you are writing to the worksheet (not just modify formulas so that they will produce whole numbers), that can be done to whole columns within the range at once, i.e.,
...
For i = 1 to rng.Columns.Count
rng.Columns(i).NumberFormat = formatArray(i)
Next
...
If you need to convert the results of a cell's formula to a rounded value, you can do that with something like
rng.Cells(2, 5).Value = WorksheetFunction.Round(rng.Cells(2, 5).Value, 0)
to give an example for a single cell. This assumes, of course, that the data feeding into the formula are already in the sheet and that the formula has been recalculated.