VBA(EXCEL) extract information from different rows with various criteria - vba

I have an excel file which contain information of the composite in 1 row and in below rows information of the components of this composite. Number of component rows below a composite are varied between 2 - 20 and there can be many composites in a file.
My question is: is it possible somehow to define how many rows are in the components and to extract information from each component in to one cell(concatenate). Problem I face is that number of rows are different each time and there can be multiple composites in the file containing components. So i do not know how to stop my loop and start a new composite aggregation.
Maybe there are ways to loop from Request1(ColumnA) and assign "Request1" as a text to every empty column below until it reaches Request2, after that is finished to concatenate based on Request"n"
Example what i want the data to look like
~~~~~~~~~~~~EDIT~~~~~~~~~~~~~~~~~~~~
I might have over complicated my question
I was just looking to concatenate information from different set of rows(for simplicity just 1 consistent cell from every row) in to 1 cell(for example last cell in the first column) for each specific composite(which contains components) My problem is I do not know how to stop the concatenation and start a new one when i am working with a new composite(new set of rows).
So as an example from the first picture, I would like to have "Request 1 Green Yellow White" (cells: A1, F1, F2,F3) populated in cell J1, and "Request 2 Amber Red White Blue" (cells: A4,F4,F5,F6,F7)populated i cell J4
#######EDIT
I have established another way of doing but still struggle with concatenation formula.
In this picture example
https://i.stack.imgur.com/iQdNu.jpg
If my table stars from row 2
=IF(A2="",J1,A2) - by putting this in column J and dragging down i will get his Request 1
Request 1
Request 1
Request 2
Request 2
Request 2
Request 2
Then deleting duplicates i will be left only with
Request 1
Request 2
Then I can concatenate columns i want going by Request 1 or request 2 criteria(index match), but I cant figure out how to do it...

You can use array formula to work out the start and end rows, like =SMALL(IF($A$2:$A$20<>"",ROW($A$2:$A$20)),ROW()) to find the next populated cell in A1:A20, where this would be in the cell G1. So in G1, I have a fixed 1, then in G2 down, I have =H1+1, then in each H filled down I have =SMALL(IF($A$2:$A$20<>"",ROW($A$2:$A$20)),ROW()) this gives the following
Unfortunately we cant do the concat using what we have in Excel, so this will help with your loop start and ends. Number of products, is the difference in the 2

If I am reading your question correctly, then the following code may help. You want to be able to add element rows beneath categories rows, and when you do that it changes the row number for every row beneath the new row. This code will show you that it doesn't matter which row the category is on because you can find it's row number any time, and also the number of elements beneath it.
The trick is to add a word in col A of each category that will not be found in any element A value. For example, A1 might read "Category: Apples"," and there may be ten element rows under "Category: Apples" And then under those rows another category in col A will be "Category: Bananas." The code below looks for the value "Category:" in col A and gets the row number of each category line and how many elements are under it. With a little math you can figure out where to insert a new line for a new element row or what row to concatenate. And you won't need to hard code the rows numbers of the category. Just run this simple code and it will give you those row numbers to get and concatenate all rows beneath any category.
Sub findCategoryRows()
Dim lastRowColA As Long, myArray() As Variant
Dim rowOfCategoryNameArray, nameOfCategoryNameArray, categoryCounter As Long
lastRowColA = ActiveSheet.Range("A65536").End(xlUp).Row
myArray = Range("A1:A" & lastRowColA)
categoryCounter = 1
ReDim rowOfCategoryNameArray(1 To 1)
ReDim nameOfCategoryNameArray(1 To 1)
For i = 1 To UBound(myArray)
If InStr(1, Range("A" & i).Value, "Category: ") Then
rowOfCategoryNameArray(categoryCounter) = i
nameOfCategoryNameArray(categoryCounter) = Range("A" & i).Value
categoryCounter = categoryCounter + 1
ReDim Preserve rowOfCategoryNameArray(1 To categoryCounter)
ReDim Preserve nameOfCategoryNameArray(1 To categoryCounter)
End If
Next i
For i = 1 To UBound(rowOfCategoryNameArray) - 1
If i <> UBound(rowOfCategoryNameArray) - 1 Then
Debug.Print nameOfCategoryNameArray(i) & " has " & (rowOfCategoryNameArray(i + 1) - rowOfCategoryNameArray(i)) - 1 & " element rows under it."
Else
Debug.Print nameOfCategoryNameArray(i) & " has " & (lastRowColA - rowOfCategoryNameArray(i)) & " element rows under it."
End If
Next i
End Sub

Related

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

Adjust criteria to depend on multiple values

I have been working on a code to copy the data from one specific range(always the same) and paste in another spreadsheet always in the row below. So basically, it starts pasting on row 11, but if I run again it will paste on the row 12 and there it goes.. The code has been working fine, but there is only one problem. It identifies the next empty row(to paste) based on the value of the column AP, but i want it to identify based on the values of all the columns between AP:BA. Thus, if there is any value on those cells, it should copy on the row below, not only if there is a value on AP. Does someone know how to change my code in order to solve this problem? Thank You very much
Sub Copy_Shanghai()
Dim count As Integer
count = 11
Do While Worksheets("Time Evolution").Range("AP" & count).Value <> ""
'<>"" means "is not empty", as long as this happens we go down looking for empty cell
count = count + 1
Loop
'Now count is row with first empty cell outside of top 10 rows in column C
Worksheets("Fill").Range("E5:P5").Copy
Worksheets("Time Evolution").Range("AP" & count).PasteSpecial xlPasteValues
End Sub

Excel VB - Multiple If Column Contains Strings Then

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

Looking through columns in Excel using VB.NET - Struggling to look past columns "AB" etc

Just had a question about my following code:
For Each c In "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If Not String.IsNullOrWhiteSpace(exsheet.Range((c & "5")).Value.ToString) Then
pointer = pointer + 1
XRisks(pointer) = exsheet.Range(c & "6").Value.ToString
End If
Next
In essence, the code looks through the 5th row of each column in an excel spreadsheet(called exsheet). If there is something in that cell, it saves it into the array (XRisks).
However, my excel spreadsheet goes past Z and continues to AA AB AC AD etc in the column headings, which means, with the code I have at the moment, it stops reading columns after column Z.
I tried adding & "AA" & "AB" & "AC" etc to the end of my alphabet string but all this did was saved A again, then A again, then A again, then B again as it is just looking at each character in my string.
Hope I have described that enough. Thanks in advance!
Joe
You can simply use .Cells instead of .Range with an index rather than letters.
For i As Integer = 1 To 50
If Not String.IsNullOrWhiteSpace(exsheet.Cells(5, i).Value.ToString) Then
...
Next
To iterate over all columns, you can try usedRange. This may be insecure, however, since the usedRange does not necessarily start on the first column if that is empty (that said, with most table-like sheets it is safe enough).
For i As Integer = 1 To exsheet.UsedRange.Columns.Count
If Not String.IsNullOrWhiteSpace(exsheet.Cells(5, i).Value.ToString) Then
...
Next

VBA Macro: Trying to code "if two cells are the same, then nothing, else shift rows down"

My Goal: To get all data about the same subject from multiple reports (already in the same spreadsheet) in the same row.
Rambling Backstory: Every month I get a new datadump Excel spreadsheet with several reports of variable lengths side-by-side (across columns). Most of these reports have overlapping subjects, but not entirely. Fortunately, when they are talking about the same subject, it is noted by a number. This number tag is always the first column at the beginning of each report. However, because of the variable lengths of reports, the same subjects are not in the same rows. The columns with the numbers never shift (report1's numbers are always column A, report2's are always column G, etc) and numbers are always in ascending order.
My Goal Solution: Since the columns with the ascending numbers do not change, I've been trying to write VBA code for a Macro that compares (for example) the number of the active datarow with from column A with Column G. If the number is the same, do nothing, else move all the data in that row (and under it) from columns G:J down a line. Then move on to the next datarow.
I've tried: I've written several "For Each"s and a few loops with DataRow + 1 to and calling what I thought would make the comparisons, but they've all failed miserably. I can't tell if I'm just getting the syntax wrong or its a faulty concept. Also, none of my searches have turned up this problem or even parts of it I can maraud and cobble together. Although that may be more of a reflection of my googling skill :)
Any and all help would be appreciated!
Note: In case it's important, the columns have headers. I've just been using DataRow = Found.Row + 1 to circumvent. Additionally, I'm very new at this and self-taught, so please feel free to explain in great detail
I think I understand your objective and this should work. It doesn't use any of the methodology you were using as reading your explanation I had a good idea how to proceed. If it isn't what you are looking for my apologies.
It starts at a predefined column (see FIRST_ROW constant) and goes row by row comparing the two cells (MAIN_COLUMN & CHILD_COLUMN). If MAIN_COLUMN < CHILD_COLUMN it pushes everything between SHIFT_START & SHIFT_END down one row. It continues until it hits an empty row.
Sub AlignData()
Const FIRST_ROW As Long = 2 ' So you can skip a header row, or multiple rows
Const MAIN_COLUMN As Long = 1 ' this is your primary ID field
Const CHILD_COLUMN As Long = 7 ' this is your alternate ID field (the one we want to push down)
Const SHIFT_START As String = "G" ' the first column to push
Const SHIFT_END As String = "O" ' the last column to push
Dim row As Long
row = FIRST_ROW
Dim xs As Worksheet
Set xs = ActiveSheet
Dim im_done As Boolean
im_done = False
Do Until im_done
If WorksheetFunction.CountA(xs.Rows(row)) = 0 Then
im_done = True
Else
If xs.Cells(row, MAIN_COLUMN).Value < xs.Cells(row, CHILD_COLUMN).Value Then
xs.Range(Cells(row, SHIFT_START), Cells(row, SHIFT_END)).Insert Shift:=xlDown
Debug.Print "Pushed row: " & row & " down!"
End If
row = row + 1
End If
Loop
End Sub
I modified the code to work as a macro. You should be able to create it right from the macro dialog and run it from there also. Just paste the code right in and make sure the Sub and End Sub lines don't get duplicated. It no longer accepts a worksheet name but instead runs against the currently active worksheet.