I am currently dealing with a fairly large (in excess of 100MB) sheet that is formatted as follows:
a;b;c;d;
1;2;3;4;
5;6;7;8;
9;;10;11;
;;12;;
i.e. it is a two-dimensional matrix with columns of uneven length.
I am trying to rewrite this monstrosity into the following format, coordinating each value with its respective first-line value:
1;a
5;a
9;a
2;b
6;b
3;c
7;c
10;c
12;c ...
So far my main opponent is the challenge of having to identify the coordinates of each single value. Since any lookup solution I have found always requires either line or column to be known, I assume that only a script can solve this. However, when I am dealing with scripts, there might yet be an easier solution to rewrite this table than one that relies on excessive searching.
What would be the best way to solve this, potentially using VBA? I'd appreciate any help with this!
Even though you didn't post any code, I think that's ok for me to help you because I once had the exact same problem.
The next code will write the matrix you asked for on columns E and F:
Sub StackOverflow()
Dim counter As Long: counter = 1
Dim x As Long: Dim y As Integer
With ThisWorkbook.Sheets("Stack")
For y = 1 To 4
For x = 1 To .Columns(y).Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
If .Cells(x, y).Value <> "" Then
.Cells(counter, 5).FormulaR1C1 = .Cells(x, y).Value
.Cells(counter, 6).FormulaR1C1 = ColumnAddress(y)
counter = counter + 1
End If
Next x
Next y
End With
End Sub
Function ColumnAddress(y As Integer) As String
Select Case y
Case 1: ColumnAddress = "a"
Case 2: ColumnAddress = "b"
Case 3: ColumnAddress = "c"
Case 4: ColumnAddress = "d"
End Select
End Function
Feel free to adjust the code addresses to your situation (i.e. Worksheets names, Macro names and cells addresses).
Related
So basically, I have a table, where in Column A, I have a repeated list of data with multiple duplicates. In Column B, I have different sets of data related to column A, and then same as Column C. What I wish to have excel do for me is to give me the table (A15:C18), where the Column A data is one cell for each value, and then all the related information is shown right next to it in a concatenated manner.
My approach so far
So basically, what I have done so far is the following approach:
Since Column A are the only thing common in defining the different
lines, so I came up with a way to define each line as a unique line,
using the following =(A1&"--"&countif($A$1:A1;A1). This formula then
helps me identify each row as A--1, A--2, A--3, B--1, B--2 and so
on. Hence I have numbered each data in each row, in a way.
Since I want a unique list, therefore using VBA I get a unique list of variables in a new sheet. Hence, I get the list of just A, B and C in a column instead of them being duplicates.
Once I have the unique list, I then use the =countif() function to count how many times, the variable shows up in the original list (Column A). Like for example, A shows up three times, hence I know that I need to extract 3 rows for this specific data point.
Then using that information, I then proceed to use the =vlookup() function, using the equation =VLOOKUP(A&"--"&1;TABLE;COLUMN)&", "&VLOOKUP(A&"--"&2;TABLE;COLUMN)&", "&VLOOKUP(A&"--"&3;TABLE;COLUMN) .... so on depending on how many times the variable is in the list.
Finally, for example, I then write the vlookup code, and I can then extract all the cells into one place.
PROBLEMS and HELP
So the above approach I have described works on a pilot scale with lots of manual changes for different data points. The problems are the following:
The process of using =vlookup() is based on the =countif() function. I wrote down a very long formula using IF statements saying that =IF(COUNTIF()=1;VLOOKUP(VAR&--&1;TABLE..);IF(COUNTIF()=2;VLOOKUP(VAR&--&1;TABLE..)&","&VLOOKUP(VAR&--&2;TABLE..); ...
Basically, I wrote the IF statement depending on the value of the countIf value. If it is 1, then extract the values for --1, but if it is 2, then do it for --1 and --2, and vice versa. But this is such a bad approach because I can not write this equation for 100 duplicates and if a data point shows up more than 100 Times, then this approach is useless. hence, I would like to know, if it is somehow possible to use a loop VBA code for excel to do a vlookup? So if countif is 4, then do a vlookup from --1 until --4 and so on?
Another limtation is that even though B shows up 2 times in column A, but it only has 1 data point in Column B, and that is the information I need. Hence I should be focusing on that instead of using the =countif() on Column A. **Any suggestions on how I can count, how much information is infront of a data point in the second column? The data in Columns B and C are unique so there are no duplicates. **
I am stuck with the above two points, which kind of makes up the engine of the workbook. So any help or suggestion on how to approach this problem would be greatly appreciated!
Below is the updated image to show the general approach:
Interesting problem, here's my approach.
Pre-requisites:
You need Microsoft Scripting Runtime: Tools -> References -> Microsoft Scripting Runtime -> check the box
There are 2 components of this code.
First the sub you will run:
Sub Concatenate_Data()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("YourWorksheetsName")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim r As Long
Dim dict As New Scripting.Dictionary
Dim letterStr As String
For r = 2 To lastRow
letterStr = ws.Cells(r, 1).Value
If dict.Exists(letterStr) Then
If Not ws.Cells(r, 2).Value = "" Then
dict(letterStr).Candy = dict(letterStr).Candy & ", " & ws.Cells(r, 2).Value
End If
If Not ws.Cells(r, 3).Value = "" Then
dict(letterStr).Juice = dict(letterStr).Juice & ", " & ws.Cells(r, 3).Value
End If
Else
dict.Add letterStr, New Letter
If Not ws.Cells(r, 2).Value = "" Then
dict(letterStr).Candy = ws.Cells(r, 2).Value
End If
If Not ws.Cells(r, 3).Value = "" Then
dict(letterStr).Juice = ws.Cells(r, 3).Value
End If
End If
Next r
Dim k As Variant
r = 2
For Each k In dict.Keys
ws.Cells(r, 5).Value = k
ws.Cells(r, 6).Value = dict(k).Candy
ws.Cells(r, 7).Value = dict(k).Juice
r = r + 1
Next
End Sub
Next is the Class (it is named Letter):
Public Candy As String
Public Juice As String
Here is the input and output I get:
Good Luck!
I need a VBA loop which searches through an entire worksheet for, say, the word "COUNTRY", and every time it is encountered, it replaces the cell +1 to the right with the word "UK".
Rest assured that this is necessary and can't be done with a column of formulae, since the word COUNTRY is scattered around the worksheet a large number of times and in an irregular way.
I really wanted to start off with some code but I can't find the way to do this. Thanks in advance!
Here is your VBA code,
Sub funcOffset()
Dim i As Long, j As Long
For j = 1 To 255
For i = 1 To Cells(Rows.Count, j).End(xlUp).Row
If Cells(i, j) = "COUNTRY" Or InStr(Cells(i, j), "COUNTRY") > 0 Then
Cells(i, j + 1) = "UK"
End If
Next i
Next j
End Sub
Note:- the code is case sensitive and checks COUNTRY in upper case only. Alter it accordingly if you need.
If I have created a collection, can I search search the collection and RETURN THE INDEX number from within the collection?
Due to my newbie status, I can't post screenshots of what I'm trying to do, so let me try to explain what I'm trying to accomplish:
I have a history log from a warehouse database in Excel format that is several thousand lines long-- each line representing a transaction of product moving in or out of as many as 10 different bins. My goal is to identify all the possible different bins in the thousands of lines, copy/transpose those ~10 bins to column headers, and then go through each transaction and copy the transaction quantity (+1,-3, etc) to the correct column, thus being able separate the transactions and more easily identify and generate an accounting of when product moved in/out of each respective bin. This would sort of look like a PivotTable, but that isn't really how it would work.
Here is the code I am working on so far, with comments. My problem is explained in the last comment:
Sub ForensicInventory()
Dim BINLOCAT As Collection
Dim Rng As Range
Dim Cell As Range
Dim sh As Worksheet
Dim vNum As Variant
Dim BINcol As Integer
Dim ACTcol As Integer
Dim QTYcol As Integer
Dim i As Integer
Dim lastrow As Long
Dim x As Long
'This part is used to find the relevant columns that will be used later
BINcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="BINLABEL", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
ACTcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="ACTION", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
QTYcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="QUANTITY", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
i = 0
Set sh = ActiveWorkbook.ActiveSheet
Set Rng = sh.Range(sh.Cells(2, BINcol), sh.Cells(Rows.Count, BINcol).End(xlUp))
Set BINLOCAT = New Collection
'This next section searches the bin column and builds the collection of unique bins that I am interested in.
On Error Resume Next
For Each Cell In Rng.Cells
If Len(Cell.Value) <> 8 And Not IsEmpty(Cell) Then
BINLOCAT.Add Cell.Value, CStr(Cell.Value)
End If
Next Cell
On Error GoTo 0
'Now I take those unique bin names and I put them into a column header on the same spreadsheet, starting in column 10, and spacing every 2 cells thereafter.
For Each vNum In BINLOCAT
Cells(1, 10 + i).Value = vNum
i = i + 2
Next vNum
'Here is where the problem exists for me. This code works and succeeds in copying the QTY
'to column 10, but what I really want to do is determine the index number of the bin from BINLOCAT,
'and use that index number to place the value under the appropriate column header.
For x = 2 To lastrow
Select Case Cells(x, ACTcol).Value
Case "MOVE-IN"
Cells(x, 10).Value = Cells(x, QTYcol).Value
Case "MOVE-OUT"
Cells(x, 10).Value = -Cells(x, QTYcol).Value
Case Else
End Select
Next x
End Sub
In the "For x = 2 to lastrow" loop, I need to find a way to get the INDEX number (1, 2, 3, etc.) from searching for the bin in collection BINLOCAT. BINLOCAT, once created, is static. I envision something like:
neededcolumn = BINLOCAT.item(cells(x,BINcol).value).index (pseudocode)
Then I would replace the 10s in the Case Stmt with "neededcolumn" and this would work.
Maybe I am taking the wrong approach, but it seems to me like I need the collection to be able to do the search portion efficiently. Any thoughts or links to a solution? Based on what I've read, elsewhere, I think that this ability as I'm describing it is not available, but I'm not sure I've understood everything I've read about collections thus far.
Instead of using a for each loop, use a for n = 1 to BINLOCAT.Count loop - then n is your index. Or did I misunderstand?
Disclaimer: Okay, I am going to answer my own question, but I was led to this answer based on #Rory's comment at 13:07 on 8/18. So, thank you, Rory! Rory's answer proper did not enlighten me in the way I needed (or I'm too dumb to see it -- always possible), so I'm not accepting his answer but I want to acknowledge his help. I still suspect there might be a better way than what I am doing, so please feel free to comment/answer/correct me.
In the interest of simplicity and thoroughness, assume the following starting data:
Range("A1:A16")=
BM182B
BM182B
BM182B
BM182B
BM182B
AS662B
BM182B
BM182B
BM182B
BM182B
AS702B
AS642B
BM182B
BM182B
BM182B
BM182B
Based on Rory's comment, this is the first piece of code I came up with:
Sub TestofCollection()
Dim BinCollection1 As Collection
Dim n As Integer
Dim x As Integer
Set BinCollection1 = New Collection
n = 1
On Error Resume Next
For Each Cell In Range("A1:A16")
BinCollection1.Add n, CStr(Cell.Value)
n = n + 1
Next Cell
On Error GoTo 0
For x = 1 To BinCollection1.Count
Range("B" & x).Value = BinCollection1.Item(x)
Next x
End Sub
The problem with this is that output, or the "index" I get, is actually the positional location of each bin during its first occurrence in the list. So the result in the output segment is "1,6,11,12" rather than the desired "1,2,3,4" for the list "BM182B, AS662B, AS702B, AS642B". Whether there is a better way, I do not know, but my solution was to create a "collection of a collection" as follows in the next code:
Sub TestofCollection2()
Dim BinCollection1 As Collection
Dim BinCollection2 As Collection
Set BinCollection1 = New Collection
Set BinCollection2 = New Collection
n = 1
On Error Resume Next
For Each Cell In Range("A1:A16")
BinCollection1.Add Cell.Value, CStr(Cell.Value)
Next Cell
For Each x In BinCollection1
BinCollection2.Add n, BinCollection1.Item(x)
n = n + 1
Next x
On Error GoTo 0
For x = 1 To BinCollection2.Count
Range("C" & x).Value = BinCollection2.Item(x)
Next x
'Test output result should be 3 below
MsgBox "Test Output: " & BinCollection2.Item("as702b")
End Sub
So now, based on this double-collection effort, I can search my multi-thousand line columns of bins and determine their index to create my offset. The index shows up as "1,2,3,4" using those keys in the list.
This is my first question and first answer on Stack Overflow. I will probably give this a couple days to see if anyone has a better answer, but then I will "accept" my own answer here since this is what helped me (can I "unaccept" my answer if a better one shows up later?). Again, comments or suggestions greatly appreciated and accepted. Thank you for viewing.
I'm new to VBA and I can't manage to do what I want although it's very simple.
I need to automatically modify cells of a big (333x333) empty (full of zeros) spreadsheet.
In a separate spreadsheet I have the row and column of all the cells to modify. (5000 of them)
A for loop seems to be suited for this purpose.
Here is the code of my macro. The problem appears on the line before the last one.
Dim val1 As String, val2 As String, i As Integer
For i = 1 To 333
Sheets("Feuil2").Activate
ActiveSheet.Cells(i, 1).Select
val1 = Cells(i, 1).Value
val2 = Cells(i, 2).Value
Sheets("Classeur2.csv").Select
Cells(val1, val2).Select
ActiveCell.FormulaR1C1 = "1"
Next i
The line that causes a problem is this one : Cells(val1, val2).Select
I believe my error is a syntax error. But I can't find out what I should add before, after or around my two variables "val1" and "val2"
What do you think ?
Thanks a lot for your help.
Nicolas.
Edit
My problem is now solved :
The first answer is exactly what I needed to male my macro work.
The second answer is the proper and faster way to do it.
No need to activate or selection sheets or cells if you're using VBA. You can access it all directly.
The code:
Dim rng As Range
For Each rng In Sheets("Feuil2").Range("A1:A333")
Sheets("Classeur2.csv").Cells(rng.Value, rng.Offset(, 1).Value) = "1"
Next rng
is producing the same result as Joe's code.
If you need to switch sheets for some reasons, use Application.ScreenUpdating = False at the beginning of your macro (and Application.ScreenUpdating=True at the end). This will remove the screenflickering - and speed up the execution.
VAL1 and VAL2 need to be dimmed as integer, not as string, to be used as an argument for Cells, which takes integers, not strings, as arguments.
Dim val1 As Integer, val2 As Integer, i As Integer
For i = 1 To 333
Sheets("Feuil2").Activate
ActiveSheet.Cells(i, 1).Select
val1 = Cells(i, 1).Value
val2 = Cells(i, 2).Value
Sheets("Classeur2.csv").Select
Cells(val1, val2).Select
ActiveCell.FormulaR1C1 = "1"
Next i
SO this started as me trying to help someone else, got stumped. So basically i have values in columns B, C, and D. if have my criteria in H2 and I2 and when my criteria in H2 and I2 matches in B and C then have the corresponding answer in D to populate J2. basically a vlookup with 2 criteria.
i have something like this.
Sub test()
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngAnswer As Range
Dim strTarget As String
Set rngCrit1 = Range("H2")
Set rngCrit2 = Range("I2")
Set rngAnswer = Range("J2")
Range("B2").Select
strTarget = ActiveCell.Value
Do While strTarget <> ""
With ActiveCell
If strTarget = rngCrit1 Then
If .Offset(0, 1).Value = rngCrit2 Then
rngAnswer.Value = .Offset(0, 2)
Else
.Offset(1, 0).Select
strTarget = ActiveCell.Value
End If
End If
End With
Loop
End Sub
Now this thing just crashes, no debugging or anything. I am self taught so i'm sure i screwed the pooch here somewhere.
*Note this is just to satisfy my own interest not really important, so if it takes you more than 5 min please help someone else that needs it more than I.
Val1 Val2 Val3 Crit1 Crit2 Answer
a r 12 g v 22
b r 14
c s 15
d s 16
e t 18
f t 19
g y 20
g v 22
sample data
It's great that you're trying to improve your VBA skills. The first thing I'd suggest, which will improve any macro you write, is to avoid using .Select. Work directly with the range objects. For instance:
Range("B2").Select
strTarget = ActiveCell.Value
becomes
strTarget = Range("B2").Value
Also, in general, use vbNullString or Len(variable)=0 when checking for "empty" values instead of "". As for why your program is crashing, it may be your use of With. Like Select, it should be avoided in most cases (definitely in this one). Although you update ActiveCell, it's within the scope of the With statement, so once you close it (End With), those changes to ActiveCell are undone (I would suggest stepping through the macro and watch the values of strTarget and ActiveCell). This may not be the case, but I know it holds for other variables, which is why I avoid With (and avoid reassigning values in a With statement)
Anyway, I'd add the following code and rewrite the loop as follows:
Dim r as range
set r = Range("B2") 'keep in mind this range is on the ActiveSheet, so you're better
'off explicitly naming the Sheet e.g. Sheet1.Range("B2")
strTarget1 = Range("B2").Value
strTarget2 = Range("C2").Value
Do While Len(strTarget) <> 0
If strTarget1 = rngCrit1 Then
If strTarget2 = rngCrit2 Then
rngAnswer.Value = r.Offset(0,2)
Exit Do
End If
End If
set r = r.Offset(1,0)
strTarget1 = r.Value
strTarget2 = r.Offset(0,1).Value
Loop
Keep in mind you could also loop with a Long counter i for the row, then call Sheet1.Cells(i,1).Value, Sheet1.Cells(i,2).Value and so on for the values of the different columns of that row (instead of using a range object and .Offset
EDIT: After running your code, the reason for the crash is due to your If statements. You want to go to the next cell regardless. Remove the Else and put the End If statements before the Select. Add an Exit Do after your assignment statement in the 2nd If, since you want to stop looping if your two columns meet the criteria. I've updated my code to show this, as well.
INDEX and MATCH, or SUMPRODUCT tend to work well for this. An example of the former:
http://support.microsoft.com/kb/59482
if you can guarantee val1 and val2 will be unique (e.g. when searching for g & v, there is only 1 line with g and v) then you can use sumifs
I put val1,val2 and val3 in columns A,B, & C, and the search into E,F and the answer in G, and came up with this formula
=SUMIFS(C2:C9,A2:A9,E2,B2:B9,F2)
of course, this fails if val3 is not numeric, or there are more than 1 line with the letters you are looking for