I have an Excel template that I am working on as a tool for our department, and it has multiple sheets that can be copied, and what it ultimately does, is compile data from the first few sheets to create a list of sheet goods to be produced in our manufacturing facility. Each line item consists of a quantity, and then a core material, and two faces. This list is a separate sheet, that can be copied to create many different lists all referencing data from the same first three sheets.
I need to be able to quickly, and in a somewhat automated process, create a secondary list from the data of the first list. The secondary list needs to tell give me a total of each unique core, face, and backer. Some of the backers are the same as the face, so those should be consolidated.
I have a macro already that can allow the user to select a range of data, and then it spits out a consolidated list with quantities and names. The problem is this only works for 3 columns of data, and uses the 3rd column as the name, and the first as the quantity. I haven't figured out how to get it to look to columns of data that are not exactly adjacent, or more than 3 columns.
I am much more comfortable with spreadsheet formulas, but I'm thinking a macro would be the best solution if I can figure it out, as the end users of this spreadsheet have limited knowledge of excel, and I don't want to rely on them memorizing a bunch of steps.
First List
Start of Second List
Here is the macro I have so far.
Sub Macro1()
Dim i, J, K, L, M, R1, R1F, C1F, Temp As Integer
Dim SemiFinalData(500, 2) As Variant
Dim FinalData(500, 2) As Variant
i = J = 0
Set InputData = Application.InputBox(prompt:="Select the full range of Data (Qty Through Description)", Type:=8)
R1 = InputData.Rows.Count 'Gets Data to Summarize and Counts the Number of Rows
For i = 1 To R1
If InputData(i, 3) <> "" Then
SemiFinalData(J, 0) = InputData(i, 1)
SemiFinalData(J, 1) = InputData(i, 2)
SemiFinalData(J, 2) = InputData(i, 3)
J = J + 1
End If
Next i 'Extracts Non-Blank Data into Array
M = 0
For i = 0 To J - 1 'Loops for each value in SemifinalData
L = 0
For K = 0 To J - 1 'Second loop for each value in SemifinalData
If SemiFinalData(i, 2) = FinalData(K, 2) Then 'Counter for Duplication Test
L = L + 1
End If
Next K
If L < 1 Then 'Tests for Duplication and Extracts Data to FinalData Array
FinalData(M, 1) = SemiFinalData(i, 1)
FinalData(M, 2) = SemiFinalData(i, 2)
M = M + 1
End If
Next i
For i = 0 To M - 1
Temp = 0
For K = 0 To J - 1
If FinalData(i, 2) = SemiFinalData(K, 2) Then
Temp = Temp + SemiFinalData(K, 0)
End If
Next K
FinalData(i, 0) = Temp
Next i
Set OutputData = Application.InputBox(prompt:="Select the first Cell of Output Range (for Qty)", Type:=8)
R1F = OutputData.Row
C1F = OutputData.Column 'Gets Row/Column for Start of Output Range
For K = 0 To 2
Cells(R1F, C1F + K).Select
For i = 0 To M - 1
Selection = FinalData(i, K)
ActiveCell.Offset(1, 0).Range("A1").Select 'Writes Data to Sheet
Next i
Next K
End Sub
Essentially I am struggling with the 3 types of data on the same row from the first list, and the best way to separate them onto their own line on the second sheet.
You may want to look at using
Worksheets().range().AdvancedFilter(....)
This could help you pick out the data that you are looking for much easier. Check the office vba reference for more details.
Related
I am trying to write a macro to loop through a spreadsheet, and on each row, concatenate three values (from different columns) into a single value (integer), and result that in another column on the same row. Then, increment from that number, based on the number from a different value in the column. Each iteration of this (including the first one) should copy the first column's value from that row, so that each increment reflects the same information in the newly created output.
Here's an example of the input data:
B2, C2, and D2 should all be concatenated, resulting in the number 5555551000, and that should be placed in cell I2. A2 should be copied to H2, as I2's location identifier. I2 should then be incremented based on the value of F2 (in this case, 10 times), and those results should be iterated under I2 starting at I3, with A2's value to the left of each output's cell, in the corresponding H column.
Here's an example of the output on the same sheet:
Once the output completes for expanding the first range of numbers, the loop continues to the next row and repeats the process.
I took a stab at this by setting the starting point, then doing a for loop with row.Count and inside of this, doing a Do While loop and breaking the loop based on the DID integer. I'm not having much success and perhaps it has to do with the way I'm using ActiveCell to try to move around during the iterations.
Any suggestions would be appreciated. I'm not allowed to embed pictures yet, thus the external links to the examples.
Like others have pointed out, its a lot easier to understand and troubleshoot what you're trying to do when you post the code, but I took a stab at it and came up with the following- quick note, this sub takes place on 2 different sheets (the source sheet, and then the resulting output sheet). If you really need it on the same sheet then I guess you could output the data right on top of the old data.
Public Sub sampleSub()
Dim sourceWS As Worksheet
Dim sourceData() As Variable
Dim outputRange As Range
Dim outputArr() As Variable
Dim readCounter As Long
Dim writeCounter As Long
Dim iterationCounter As Long
Set sourceWS = ThisWorkbook.Sheets(1)
sourceData = sourceWS.Range("A2:F4").Value2 'Read in source data
'Redim outout array with enough rows to be able to store each iteration (column F => 10 + 120 + 1000...)
ReDim outputArr(1 To Application.WorksheetFunction.Sum(sourceWS.Range("F2:F4")), 1 To 9)
For readCounter = 1 To UBound(sourceData, 1) 'Loop through each row of source data
For iterationCounter = 0 To sourceData(readCounter, 6) - 1 'Iterates to # in source data column F
writeCounter = writeCounter + 1
outputArr(writeCounter, 1) = sourceData(readCounter, 1) 'Write source data column A to output column A
outputArr(writeCounter, 2) = sourceData(readCounter, 2) 'Write source data column B to output column B
outputArr(writeCounter, 3) = sourceData(readCounter, 3) 'Write source data column C to output column C
outputArr(writeCounter, 4) = sourceData(readCounter, 4) 'Write source data column D to output column D
outputArr(writeCounter, 5) = sourceData(readCounter, 5) 'Write source data column E to output column E
outputArr(writeCounter, 6) = sourceData(readCounter, 6) 'Write source data column F to output column F
outputArr(writeCounter, 7) = sourceData(readCounter, 7) 'Write source data column G to output column G
outputArr(writeCounter, 8) = sourceData(readCounter, 1) 'Write source data column A to output column H
'Concatonate source data columns B, C & D and then adds iteration counter
outputArr(writeCounter, 9) = CLng(sourceData(readCounter, 2) & sourceData(readCounter, 3) & sourceData(readCounter, 4)) + iterationCounter
Next
Next
'User selects target range and then data is outputted
Set outputRange = Application.InputBox("Select target for output:", Type:=8)
outputRange.Resize(UBound(outputArr, 1), UBound(outputArr, 2)) = outputArr
End Sub
Hope this helps,
TheSilkCode
I want to copy the cells "A2:A" & patientprofiles + 1 and paste them in the first unused row in column D (i.e., there should be no blank cells between what's already in column D and what I want to paste there, but I also don't want to paste over what's already there). I then want to repeat this process a user-defined number of times (this variable will be called g1_observations). I then want to copy the cells "A" & patientprofiles + 2 & ":A" & 2 * patientprofiles + 1 to the new last used row in column D (i.e., taking into account that I've just pasted patientprofiles number of cells g1_observations number of times at the bottom of column D. I want to continue repeating this process a user-defined number of times (this number of times is defined by the variable numberofgrids).
For example: imagine that the user has defined that there will be three grids. Grid 1 will have 2 observations, Grid 2 will have 3 observations, and Grid 3 will have 4 observations. Also imagine that patientprofiles has been set to 40.
If this is the case, there will already be values in cells D1:D121, so I want to begin pasting in D122. I want to paste the cells A2:A41 (40 cells because patientprofiles = 40) to cells D122:D161; I want to paste the cells A42:A81 to cells D162:D201 and again to D:202:D241; and I want to paste cells A82:A121 to cells D242:D281, again to cells D282:D321, and again to cells D322:D361. I'm pasting each "grid" one less time than the number of observations for that grid, because the first group of observations for all grids is what's contained in cells D2:D121. End example
I'm pretty sure I need to use a nested For...Next loop in order to do this, but I'm having trouble with both the inner and outer loop. I think the outer loop should go something like this:
Dim i as long
For i = 0 to numberofgrids - 1
[insert inner loop here]
Next
As far as the inner loop goes, I'm not really sure what I'm doing because it keeps pasting over itself when I am pasting from two grids. The current code I have uses repeated For...Next loops and doesn't work:
Dim myLastRow as Integer
myLastRow = Worksheets("Work").UsedRange.Rows.Count
Dim j as Long
For j = 1 To g1_observations - 1
If j = 1 Then
Range(Cells(2, 1), Cells((patientprofiles + 1), 1)).Copy _
Destination:=Worksheets("Work").Cells(j * myLastRow + 1, 4)
ElseIf j > 1 Then
Range(Cells(2, 1), Cells((patientprofiles + 1), 1)).Copy _
Destination:=Worksheets("Work").Cells((j + 1) * (myLastRow / 2) + 1, 4)
Else: Range("A1").Select
End If
Next
For j = 1 To g2_observations - 1
If j = 1 Then
Range(Cells(patientprofiles + 2, 1), Cells((2 * patientprofiles + 1), 1)).Copy _
Destination:=Worksheets("Work").Cells(j * myLastRow + 1, 4)
ElseIf b > 1 Then
Range(Cells(patientprofiles + 2, 1), Cells((2 * patientprofiles + 1), 1)).Copy _
Destination:=Worksheets("Work").Cells((b + 1) * (myLastRow / 2) + 1, 4)
Else: Range("A1").Select
End If
Next
It pastes over itself, and sometimes it skips lines. I can't really figure out how to reconcile myLastRow with a loop.
I think the inner loop should probably start off something like this:
Dim j as Long
For j = 0 to gj_observations - 1
Range(Cells(j * XXX + 2, 1), Cells((j + 1) * patientprofiles + 1).Copy _
Destination:=Worksheets("Work").Cells(myLastRow * j + 1) , 4
but I'm having difficulty because the variables are called g1_observations, g2_observations, g3_observations, etc., all the way up to g10_observations, and obviously gj_observations won't work. I want to loop on the number between "g" and "_", but I don't know how to get VBA to read variables that way, or if that's possible at all.
Can anyone help me out here? My mind is spinning from trying to understand the concept of loops, especially with different variables at each level.
Also, side question, how do you tell VBA to do nothing in an If statement? I currently have it selecting A1 by writing Else: Range("A1").Select, but I'm sure there's a better way of doing it.
When you're writing macros, it's a better practice to work with ranges and avoid manipulating cells one at a time in a loop. Your macro will run much faster and the code will be clearer.
If you want to create a set of variables that you can access by number, you would use something called an array. This is a pretty fundamental concept that exists in almost every programming language, so I'll refer you to MSDN or your favorite VBA language reference guide for more details.
Dim ws As Worksheet
Dim lr As Long ' Last Row
Dim szpp As Long ' Size (rows) patient profiles
Dim szgobsrv(2) As Long ' Size (rows) observation groups
Dim i As Long
Dim j As Long
Dim SourceCells As Range
Dim TargetCell As Range
Set ws = Sheets("Work")
szpp = 40
szgobsrv(0) = 1
szgobsrv(1) = 2
szgobsrv(2) = 3
For i = 0 To UBound(szgobsrv)
lr = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
' copy the patient profile cells multiple times depending on group size
For j = 0 To szgobsrv(i) - 1
Set SourceCells = ws.[A2].Offset(i * szpp).Resize(szpp)
Set TargetCell = ws.[D1].Offset(lr + j * szpp)
SourceCells.Copy TargetCell
Next
Next
Note the usage of the Resize and Offset methods. These are helpful Range methods that can change the size and position of a range by a fixed amount.
The main problem you are having with values being over written is that youre not using Offset.
Another important thing to remember about nested loops is that the nested loop runs i times per loop of the upper level loop. I am thinking that nested loops here might not be good for you. You could probably just make them all independent loops?
If you want to loop to the number contained within the variable you might want to set that variable equal to a number.
example:
g2_observations =2
For j = 1 To g2_observations - 1
Aside from this I am actuall yhaving difficulty understanding what you need, but hopefully this helps?
numberofgrids = input
i = 1 to numberofgrids
gridCount = gridCount + 1
'Loop Stuff
Case Select gridCount
Case is = 1
'logic
Case is = 2
'logic
Etc etc
End Select
If numberofgrids = gridCount Then
Exit For
End If
Next i
I have an Excel table.
And I need to write its data into a single column, row by row, every row is "read" from left to right, zeroes excluded. Please look at the picture to understand better:
Is there a way to do it quickly using VBA? I tried using only formulas and it worked, but it took several steps (creating a column, excluding zeroes, re-writing the column...) and really slowed down the whole process.
To copy all the non empty values from a range to a single column:
Dim source(), arr(), r&, c&, i&
' read the data from the range
source = [A1:G3].Value2
' copy the non empty value
ReDim arr(1 To UBound(source, 1) * UBound(source, 2), 1 To 1)
For r = 1 To UBound(source, 1)
For c = 1 To UBound(source, 2)
If source(r, c) <> Empty Then
i = i + 1
arr(i, 1) = source(r, c)
End If
Next
Next
' write the data back to the sheet
[A7].Resize(i, 1) = arr
I have part of a code where I have two worksheets named "Dia" and "E" and there is a time column in both of the worksheets. I am writing a program that will compare the cells of the two columns to each other and arrange the time in ascending order, which will be placed in a third worksheet named "E_Dia". When I run the code, the code executes the loops but in a very strange fashion. Instead of arranging the time, it first paste all the values of the time cells of the first sheet and then paste the values from the second sheet.
Dim i As Long ' initiating long variable
Dim l As Long
Dim j As Long
j = 2
l = 2
For i = 2 To LastRow_Dia
Do While ActiveWorkbook.Sheets("Dia").Cells(i, 4).Value >= ActiveWorkbook.Sheets("E").Cells(j, 4).Value
ActiveWorkbook.Sheets("E_Dia").Cells(l, 4).Value = ActiveWorkbook.Sheets("E").Cells(j, 4).Value
j = j + 1
l = l + 1
Loop
ActiveWorkbook.Sheets("E_Dia").Cells(l, 4).Value = ActiveWorkbook.Sheets("Dia").Cells(i, 4).Value
l = l + 1
Next i
The desired result example is as follows:
the first 24 rows should have time values from the "E" worksheet as the time in those rows have smaller values. The 25th row should have time value from the "Dia" worksheet but it doesn't give the desired output.
I'm trying to list 50 rows x 8 columns of cells (defined 'allhazards') into one column
However each cell in myhazards is referencing other sheets and contain 0's where there is no text to be referenced.
When I list the data in 'allhazards' in a single column using this formula:
=INDEX(allhazards,1+INT((ROW($A1)-1)/COLUMNS(allhazards)),MOD(ROW($A1)-1+COLUMNS(allhazards),COLUMNS(allhazards))+1)
(then drag down the column to get all of the cells from 'allhazards')
How do I implement this:
if cell in 'allhazards' is 0, do not reference this cell, move to next row
...then reference next row's columns until cell is 0, then move to next row
...keep doing this until there are no rows left to be referenced
eg. if 'allhazards' contained these cells (eg. 2 rows x 8 columns):
hello how are 0 0 0 0 0
good 0 0 0 0 0 0 0
It should produce this when dragging down the formula:
hello
how
are
good
but not this:
hello
how
are
0
0
0
0
0
good
0
0
0
0
0
0
0
I created a UDF for your situation. Please place the following procedure in a standard code module.
Public Function MATRIX2VECTOR(r As Range)
Dim i&, j&, k&, v, m, o
v = r
ReDim o(1 To Application.Caller.Rows.Count, 1 To 1)
For i = 1 To UBound(v, 1)
For j = 1 To UBound(v, 2)
m = v(i, j)
If Len(m) Then
If m <> 0 Then
k = k + 1
o(k, 1) = v(i, j)
End If
End If
Next
Next
For k = k + 1 To UBound(o): o(k, 1) = "": Next
MATRIX2VECTOR = o
End Function
Now you can call it in a formula from the worksheet just like any of the built-in functions.
1
Select a vertical range of cells tall enough to accommodate the transposed data.
2
Click in the Formula Bar at the top of Excel.
3
Enter this formula:
=MATRIX2VECTOR(allhazards)
4
This is an array formula and must be confirmed with Ctrl+Shift+Enter.
If you're interested in a non-VBA solution:
=IF(ROWS($1:1)>COUNTIF(allhazards,"<>0"),"",INDIRECT(TEXT(AGGREGATE(15,6,(10^5*ROW(allhazards)+COLUMN(allhazards))/(allhazards<>0),ROWS($1:1)),"R0C00000"),0))
Copy down as required.
This will be more efficient if you use a single helper cell to store the number of non-zero entries in allhazards, and also store the ROW/COLUMN portion as a Defined Name. For example, if you put:
=COUNTIF(allhazards,"<>0")
in e.g. J1, and define, in Name Manager, Arry1 as:
=10^5*ROW(allhazards)+COLUMN(allhazards)
then the main formula becomes:
=IF(ROWS($1:1)>$J$1,"",INDIRECT(TEXT(AGGREGATE(15,6,Arry1/(allhazards<>0),ROWS($1:1)),"R0C00000"),0))
If your data is in a different sheet to that housing the results, simply include the sheet name containing the data, viz:
=IF(ROWS($1:1)>$J$1,"",INDIRECT("'YourSheetName'!"&TEXT(AGGREGATE(15,6,Arry1/(allhazards<>0),ROWS($1:1)),"R0C00000"),0))
Regards