I am taking an excel spreadsheet as an input. Within this spreadsheet there are a series of variables (in my case, nodes, but the distinction is irrelevant). Each node has a series of sub-variables associated with them (essentially, a series of cases), and each case has three float variables associated with them (X, Y, and Z coordinates). It can be visualized like so:
NODE 1 CASE 1 CASE 1 X
CASE 1 Y
CASE 1 Z
CASE 2 CASE 2 X
CASE 2 Y
CASE 2 Z
NODE 2 CASE 1 CASE 1 X
CASE 1 Y
CASE 1 Z
CASE 2 CASE 2 X
CASE 2 Y
CASE 2 Z
See the image below for the format of my input data. Note that there can be potentially hundreds of individual points.
Now here is where i'm stuck:
I need to read this data in, point by point, and process it. The various variables will be processed and outputted onto a new sheet, but i can't come up with an elegant way of reading in the data to be processed. If this were Python, i'd establish a class for the various points and associate methods with that class, but i don't know an analogous version for VBA.
What is the most efficient way to iterate through each point, read in the data associated with each case for each point, process it, and output the end result to a new sheet?
Thanks in advance for any help. This one really has me stuck.
Try this (change “myInputSheetName” and “myOutputSheetName” with your actual inout and output sheet name):
Sub ReadDataIn()
Dim data As Variant
Data = Worksheets(“myInputSheetName”).UsedRange.Value
‘ and now you have a 2D array with as many rows and columns as excel sheet rows and columns with data
Dim iRow As Long, jCol As Long
For iRow = 1 To Ubound(data,1)
For jCol = 1 To Ubound(data,2)
MsgBox data(iRow, jCol)
‘Process your data
Next
Next
‘Write processed data into your output sheet
Worksheets(“myOutputSheetName”).Range(“A1”).Resize(Ubound(data, 1), Ubound(data, 2)).Value = data
End With
End Sub
Related
hopefully someone will be able to help me. I need to write a query, which would shrink the data from multiple columns (in my case from columns A:H) into one column.
The original file looks like this:
I need to shrink the data one by one by rows. I mean, the query has to check the first row and take the data (name), and put it into "a new column" then check the second column and do the same, and continue like this one by one. The table has 170 rows.
I found a query that is shrinking the data from multiple columns into one column but in another order than I need. The query is taking as first all data from a column A and putting it into "a new column", then taking all data from a column B and putting it into "a new column" under the data from the previous column (column A).
This is the query I tried to apply:
Please could somebody help me with it? I have to admit that I have not use UBound and LBound functions and I am getting pretty lost here. :(
I will be thankful for any advise how to adjust this query.
Many thanks in advance! :)
Try this. I'm first setting your range to an array. I then loop through the array and 'slice' each row using Application.Index. It then Joins all the content in that row together before Trimming the whitespace left over from either end. This leaves me with the one value in my results array (tmp). The code then clears your source data before leaving all your data in one column.
Sub CombineColumns()
Dim rng As Range
Dim tmp As Variant, vaCells As Variant
Dim i As Long
Set rng = Sheets("DATA").Range("A2:H200")
vaCells = rng.Value2
ReDim tmp(LBound(vaCells) To UBound(vaCells))
For i = LBound(tmp) To UBound(tmp)
tmp(i) = Trim(Join(Application.Index(vaCells, i, 0)))
Next i
With rng
.ClearContents
.Cells(1).Resize(UBound(tmp)).Value2 = Application.Transpose(tmp)
End With
End Sub
LBound returns the lowest position in the array (usually 0 or 1) and UBound returns the highest
I think something like this
for i = 1 to 170
for y = 1 to 8
if worksheets("trainers").cells(i,y).value <> "" then
worksheets("output").cells(i,1).value = worksheets("trainers").cells(i,y).value
exit for
end if
next y
next i
or on same sheet
For i = 1 To 170
Z = 0
For y = 1 To 8
If Cells(i, y).Value = "" Then
Cells(i, y).Delete Shift:=xlToLeft
Z = Z + 1
If Z <= 8 Then y = y - 1
End If
Next y
Next i
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
Currently I have a worksheet which has different colored cells in it like the one below:
[currentsheet] http://imgur.com/na6nvNH
I am using an array to count the colored cells per column. Here is my a snippet of my code:
Dim difference(0 To 41) As Long
For Each mycell In ActiveWorkbook.Worksheets("Differences").UsedRange
Dim col As Long
col = mycell.Column
If ActiveWorkbook.Worksheets("Differences").Cells(mycell.Row,mycell.Column).Interior.Color = vbRed Then
difference(col) = difference(col) + 1
End If
Next mycell
Sheets("Summary").Cells(47, 3) = difference(0)
Sheets("Summary").Cells(48, 3) = difference(1)
Sheets("Summary").Cells(49, 3) = difference(2)
etc.
Which will list the amount of colored cells I have per column. I need help breaking this down so I can create a table which shows the number of colored cells per department. I have no idea on how to do this!
To make it easier to view I am looking to create this:
[FinalSheet] http://imgur.com/i6W60m7
I should add: the amount of rows within the sheet can vary, they can also vary per department
Tried applying a column filter beginning with the first department and then counting the colored cells once the filter was applied, however since I am looking at every cell in the code above the result is still per column.
For anyone looking for an answer to this, a rather long method. However, I applied a filter and then set the range to only the visible cells instead of the used range in the whole worksheet
It seems it would be a lot easier to use a multi dimensional array, so you would have Array(4,7) so some sudo code might look like. I could do real code, but you seem to know what your doing.
Select Case mycell.row
Case 1
Array(1,Col) = Array(1,Col) + 1
Case 2
Array(1,Col) = Array(1,Col) + 1
Case 3
Array(2,Col) = Array(2,Col) + 1
end select
The trick to a multi dimensional array is to think of it like a spread sheet, (2,2) = 3 rows, by 3 columns ... (3 because arrays start at 0) The beauty of it is, if you do it this way when it comes to extract the data you simply put a double loop
For I =0 to Ubound(Array)
For II = 0 to Ubound(Array,2)
Cell(I,II).Value = Array(I,II)
next
next
I'm looking for an alternative to this code, but using numbers.
I want to select 5 columns, the start column is a variable, and then it selects 5 columns from this.
Columns("A:E").Select
How do I use integers instead, to reference columns? Something like below?
For n = 1 to 5
Columns("n : n + 4") .select
do sth
next n
You can use resize like this:
For n = 1 To 5
Columns(n).Resize(, 5).Select
'~~> rest of your code
Next
In any Range Manipulation that you do, always keep at the back of your mind Resize and Offset property.
Columns("A:E").Select
Can be directly replaced by
Columns(1).Resize(, 5).EntireColumn.Select
Where 1 can be replaced by a variable
n = 5
Columns(n).Resize(, n+4).EntireColumn.Select
In my opinion you are best dealing with a block of columns rather than looping through columns n to n + 4 as it is more efficient.
In addition, using select will slow your code down. So instead of selecting your columns and then performing an action on the selection try instead to perform the action directly. Below is an example to change the colour of columns A-E to yellow.
Columns(1).Resize(, 5).EntireColumn.Interior.Color = 65535
you can use range with cells to get the effect you want (but it would be better not to use select if you don't have to)
For n = 1 to 5
range(cells(1,n).entirecolumn,cells(1,n+4).entirecolumn).Select
do sth
next n
Try using the following, where n is your variable and x is your offset (4 in this case):
LEFT(ADDRESS(1,n+x,4),1)
This will return the letter of that column (so for n=1 and x=4, it'll return A+4 = E). You can then use INDIRECT() to reference this, as so:
COLUMNS(INDIRECT(LEFT(ADDRESS(1,n,4),1)&":"&LEFT(ADDRESS(1,n+x,4),1)))
which with n=1, x=4 becomes:
COLUMNS(INDIRECT("A"&":"&"E"))
and so:
COLUMNS(A:E)
In the example code below I use variables just to show how the command could be used for other situations.
FirstCol = 1
LastCol = FirstCol + 5
Range(Columns(FirstCol), Columns(LastCol)).Select
no need for loops or such.. try this..
dim startColumnas integer
dim endColumn as integer
startColumn = 7
endColumn = 24
Range(Cells(, startColumn), Cells(, endColumn)).ColumnWidth = 3.8 ' <~~ whatever width you want to set..*
You can specify addresses as "R1C2" instead of "B2". Under File -> Options -> Formuals -> Workingg with Formulas there is a toggle R1C1 reference style. which can be set, as illustrated below.
I was looking for a similar thing.
My problem was to find the last column based on row 5 and then select 3 columns before including the last column.
Dim lColumn As Long
lColumn = ActiveSheet.Cells(5,Columns.Count).End(xlToLeft).Column
MsgBox ("The last used column is: " & lColumn)
Range(Columns(lColumn - 3), Columns(lColumn)).Select
Message box is optional as it is more of a control check. If you want to select the columns after the last column then you simply reverse the range selection
Dim lColumn As Long
lColumn = ActiveSheet.Cells(5,Columns.Count).End(xlToLeft).Column
MsgBox ("The last used column is: " & lColumn)
Range(Columns(lColumn), Columns(lColumn + 3)).Select
In this way, you can start to select data even behind column "Z" and select a lot of columns.
Sub SelectColumNums()
Dim xCol1 As Integer, xNumOfCols as integer
xCol1 = 26
xNumOfCols = 17
Range(Columns(xCol1), Columns(xCol1 + xNumOfCols)).Select
End Sub
I decided to start this question from scratch to clarify the question and goal.
Things to note about my data
I have a spreadsheet containing laptop product data
Each product has a Model and a SKU value
Many models have multiple SKUs associated with them
When more than 1 SKU fits into a model, there is a new row for each SKU. In this instance, each row will have the same value in the model field
Some models may have 4 batteries & 1 charger, others may have 1 battery & 2 chargers, others may have 1 battery & no charger or vice versa... what i'm trying to say is there is no set rule or relation between number of SKUs
There are two types of products, batteries & chargers
All Battery products have SKUs that begin with 'BAT'
All charger products have SKUS that begin with either 'ACA' or 'ACS'
I can easily split the two types of data to help achieve the goal - SKU, model & category data can be placed side by side in columns or in separate worksheets for each type of product (battery or charger)
Example data formatted side by side in same worksheet:
Example data in separate worksheets (sheet1 = batteries, sheet2 = chargers):
Regardless of which method is used, the model field could be positioned anywhere in column A - the model field will not be in an adjacent cell when comparing the two sets of data (as illustrated)
What I am trying to achieve
For each model, I need to have a row of data containing a battery SKU and a charger SKU
There should be a new row for the same model until all combinations are output for that model
There should be a maximum of 2 SKUs in the output for each row. This should always contain 1 battery and 1 charger
Desired Output
It is worth mentioning that this is a very small sample of the data I will be working with, full data set is more than 60k rows and growing so the solution would need to be efficient.
I'm using excel 2007.
I am a complete noob with VBA, I have purchased some plug ins to try and achieve my goal, I have spent 2 days researching and trying various methods to do this but all to no avail.
I thought that I had got close with this answer from Santosh:
https://stackoverflow.com/a/19780188/1018153
Which is what I based my previous question on, but as well as that producing duplicates and matching data between models, I couldn't actually format my data in it's complete form for that script to work for me anyway, so my original question was irrelevant.
The below statement should still work, but I wrote code to try to explain how it would work
Option Explicit 'This ensures typos in variable names are flagged
Sub MakeList()
Dim BatteryList As Range
Dim ChargerList As Range
Dim CurrentModel As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim resultrange As String
'look at the lists - note I am not looking at the type - I'm going to assume
'that we can set the address correctly
'use End(xLdown) to find the last cell - that way we don't need to
'remember to change it when the number of items changes
Set BatteryList = Worksheets("Sheet1").Range("A2", Range("sheet1!B1").End(xlDown))
Set ChargerList = Worksheets("Sheet2").Range("A2", Range("Sheet2!B1").End(xlDown))
'note the use of the Sheet2! and sheet1! in the .End(xlDown) - this is required
'even though we have the Worksheets(" to set the range
i = 2 ' result row
For j = 1 To BatteryList.Rows.Count ' look at each battery row
CurrentModel = BatteryList(j, 1)
For k = 1 To ChargerList.Rows.Count 'then look at each charger row
If ChargerList(k, 1) = CurrentModel Then
'and only write a row if the battery and charger models match
Worksheets("Sheet3").Cells(i, 1) = CurrentModel
Worksheets("Sheet3").Cells(i, 2) = BatteryList(j, 2)
Worksheets("Sheet3").Cells(i, 3) = ChargerList(k, 2)
i = i + 1
End If
Next k
Next j
End Sub
PreviousAnswer
Looking at the code in the question you pointed to, you would need to store the current model, and only add in the possibilities when the model matches. This will result in lots of #N/A! 's when the data is written out, but that should be a minor fix.
at this line:
Do While j <= UBound(c1)
I would insert the code to hold the current model
Dim OnlyThisModel as string
Do While j <= UBound(c1)
OnlyThisModel=c1(j,1)
and in this area
Do While m <= UBound(c4)
out(n, 1) = c1(j, 1)
out(n, 2) = c2(k, 1)
out(n, 3) = c3(l, 1)
out(n, 4) = c4(m, 1)
n = n + 1
m = m + 1
Loop
Check that the model is correct, and don't write if not:
Do While m <= UBound(c4)
if c1(j,1)=OnlyThisModel then
'Only write out data if model matches
out(n, 1) = c1(j, 1)
out(n, 2) = c2(k, 1)
out(n, 3) = c3(l, 1)
out(n, 4) = c4(m, 1)
n = n + 1
end if
'go to next record, regardless of if a combination was written
m = m + 1
Loop