I have created a macro that looks at number in a cell and then copies a group of three columns and inserts them to the right of the group. This all works fine.
I have a formula in a cell after these groups of columns that looks to see if there is a 1 in the cell. the code below is what there would be assuming I created 2 groups.
=IF(AND(H9=1,J9=1),1,0)
I want to be able to automatically add the M9=1,P=1 if I had created four groups.
If someone has the time to help it would be much appreciated.
Sorry, learning as I go on here.
I am creating a matrix where I can build up a number of functions in the columns direction and a number of inputs that effect the functions in the rows direction.
I start off with a 'group' of three columns per function, In my first group G9 is the expected condition, H9 is the result during simulation and I9 is the result during real world tests. I want to be able to say how many functions and inputs there will be and automatically create the matrix.
If I have two functions then there will be two groups of columns from G to L.
After all of the functions I have a check to see if they all passed, with two functions this check would be in M9, where I have the formula =IF(AND(H9=1,K9=1),1,0) that checks to see if there is a 1 in both H9 and K9 and then puts a 1 in M9.
If I had four functions then I would need the check formula of =IF(AND(H9=1,K9=1,N=1,Q=1),1,0) in S1
I want to create the check formula within a loop so that it adds in the correct cells to check.
Hope this explains it a little bit better, but probably not!!
Here is the code so far
Private Sub CommandButton1_Click()
' Copy the template worksheet
Worksheets("ZoneTemplate").Copy After:=Worksheets("ProjectConfig")
' Rename the worksheet to the correct Zone
Sheets("ZoneTemplate (2)").Name = Sheets("ProjectConfig").Range("B9")
' Setup the variables
Dim Loop1 As Integer
Dim MySheet As String
Dim NoOfOutputs As Integer
Dim NoOfColumnsOffset As Integer
Dim Loop2 As Integer
' Get the name of the sheet ready for use in the loop
MySheet = Sheets("ProjectConfig").Range("B9").Value
' Get the number of outputs to add
NoOfOutputs = Sheets("ProjectConfig").Range("E9") - 1
' Loop for the number of safety output functions
For Loop1 = 1 To NoOfOutputs
' select the columns to copy and copy them to buffer
Worksheets(MySheet).Range("G:I").Select
Selection.Copy
' Insert the copied columns infront of J1 and shift everything along to the right
Worksheets(MySheet).Range("J1").Insert Shift:=xlShiftToRight
Next Loop1
End Sub
So this did the trick....
Private Sub CommandButton1_Click()
' Copy the template worksheet
Worksheets("ZoneTemplate").Copy After:=Worksheets("ProjectConfig")
' Rename the worksheet to the correct Zone
Sheets("ZoneTemplate (2)").Name = Sheets("ProjectConfig").Range("B9")
' Setup the variables
Dim Loop1 As Integer
Dim MySheet As String
Dim NoOfOutputs As Integer
Dim NoOfInputs As Integer
Dim NoOfColumnsOffset As Integer
Dim Loop2 As Integer
Dim Loop3 As Integer
Dim loop4 As Integer
Dim SOAddr1 As String
Dim SimAddr As String
MySheet = Sheets("ProjectConfig").Range("B9").Value ' Get the name of the sheet ready for use in the loop
NoOfOutputs = Sheets("ProjectConfig").Range("E9") - 1 ' Get the number of outputs to add
' Loop for the number of safety output functions
For Loop1 = 1 To NoOfOutputs
Worksheets(MySheet).Range("Safety_Output_Function").Select ' select the columns to copy and copy them to buffer
Selection.Copy
Worksheets(MySheet).Range("J7").Insert Shift:=xlShiftToRight ' Insert the copied columns infront of J1 and shift everything along to the right
Next Loop1
' Loop to generate the formula for the Sim Result check
For Loop2 = 1 To (NoOfOutputs) 'Sheets("ProjectConfig").Range("E9")
NoOfColumnsOffset = 8 + (Loop2 * 3) ' Work out the cell number for the new column
SOAddr1 = Cells(9, NoOfColumnsOffset).Address(RowAbsolute:=False, ColumnAbsolute:=False) ' Convert the cell number to a letter reference
SimAddr = SimAddr & "," & SOAddr1 & "=1" ' build the string to add for each column and each time we come round the loop
Next Loop2
' put the new formulas in
Worksheets(MySheet).Cells(9, (NoOfColumnsOffset + 2)).Formula = "=IF(AND(H9=1" & SimAddr & "),1,0)"
' Loop to generate the formula for the Hardware Result check
For Loop3 = 1 To (NoOfOutputs) 'Sheets("ProjectConfig").Range("E9")
NoOfColumnsOffset = 9 + (Loop3 * 3) ' Work out the cell number for the new column
SOAddr1 = Cells(9, NoOfColumnsOffset).Address(RowAbsolute:=False, ColumnAbsolute:=False) ' Convert the cell number to a letter reference
SimAddr = SimAddr & "," & SOAddr1 & "=1" ' build the string to add for each column and each time we come round the loop
Next Loop3
' put the new formulas in
Worksheets(MySheet).Cells(9, (NoOfColumnsOffset + 2)).Formula = "=IF(AND(I9=1" & SimAddr & "),1,0)"
NoOfInputs = Sheets("ProjectConfig").Range("D9") - 1 ' Get the number of Inputs to add
' Loop for the number of safety output functions
For loop4 = 1 To NoOfInputs
Worksheets(MySheet).Range("9:9").Select ' select the columns to copy and copy them to buffer
Selection.Copy
Worksheets(MySheet).Range("A10").Insert Shift:=xlDown ' Insert the copied columns infront of J1 and shift everything along to the right
Next loop4
End Sub
Related
I am trying to make a sub that loops through 31 columns on one worksheet to find the number of 0's that exist in each column. Each column can have a different amount of data, up to 25,000 cells in each column. I need to take the number of 0's counted and paste it in the 47th row of each column. The data that I need to count starts in row 49 and can go to 25,049. My thought process was to count the number of rows with data instead of having VBA look through possible blank cells to save performance. When I ran the code below, it never counted more than 1 zero in each row. Most of them said there was no instances of a zero when there would be like 9 of them. I'm not sure where I'm going wrong.
Sub FindingZeros()
'________________________________________
'TO DO:
'Filter data in this workbook for 0's and
'count instances
'________________________________________
Dim zeros As Integer
Dim currcol As Integer
Dim temp As Worksheet
Set temp = Worksheets("306 Toyota 2.5L")
For currcol = 2 To 32
Dim lastrow1 As Long
lastrow1 = temp.Range(Cells(49, currcol), Cells(temp.Rows.Count, currcol)).End(xlUp).Row
zeros = Application.WorksheetFunction.CountIf(Range(Cells(49, currcol), Cells(lastrow1, currcol)), 0)
temp.Cells(47, currcol).Value = zeros
Next currcol
End Sub
The main issue you were having was identifying the last used row of a column, in this instance we do not need to know the range but just the last row, so lastrow1 only needs the last row number.
Then we do not need to set a variable of for the zeros as the value can be put directly in to the cell.
Refer to the comments:
Sub FindingZeros()
Dim currcol As Integer
Dim temp As Worksheet
Dim lastrow1 As Long
Set temp = Worksheets("306 Toyota 2.5L")
For currcol = 2 To 32
' find last used row of column
lastrow1 = Cells(temp.Rows.Count, currcol).End(xlUp).Row
' set the value of the cell to the counted zeroes.
Cells(47, currcol).Value = Application.WorksheetFunction.CountIf(Range(Cells(49, currcol), Cells(lastrow1, currcol)), 0)
Next currcol
End Sub
I'm currently working on a project on VBA that requires multiple manipulation on data.
So, the main idea of this will be to get the data that I have on "Q1" and paste it 4 times on A (starting at the first blank cell), after that, take the data from "Q2" and do the same until there is no more data on the "Q" column. After there is no more data, the process should stop.
Later on I may need to modify the process, so the value gets pasted only 2 or 3 times instead of 4.
Something like this:
Column Q data:
Expected result:
I think this will do what you want:
Option Explicit
Sub Transpose_Multiplied()
Dim Number_Of_Repetitions As Integer
Dim Input_Column As String
Dim Output_Column As String
' -----------------------------------------------------------
' These are the control variables ....
Number_Of_Repetitions = 4
Input_Column = "Q"
Output_Column = "A"
' -----------------------------------------------------------
Dim WSht As Worksheet
Dim Cell As Range
Dim LastACell As Long
Dim i As Integer
Set WSht = ActiveWorkbook.ActiveSheet
For Each Cell In WSht.Range(Input_Column & "2:" & Input_Column & WSht.Cells(WSht.Rows.Count, Input_Column).End(xlUp).Row)
For i = 1 To Number_Of_Repetitions
LastACell = WSht.Cells(WSht.Rows.Count, Output_Column).End(xlUp).Row
If LastACell = 1 And WSht.Cells(LastACell, Output_Column).Value = vbNullString Then
WSht.Cells(LastACell, Output_Column).Value = Cell.Value
Else
WSht.Cells(LastACell + 1, Output_Column).Value = Cell.Value
End If
Next
Next
End Sub
So, I open up my workbook and leave it open on the Worksheet where the data to be processed is. Then I run the macro from my PERSONAL.XLSB:
In a column filled mostly by blank cells, I need to get the value of the cell thats closest to the currently selected one, in a row before it, and isn't blank.
While the "isn't blank" part can be easily achieved with the an IF and ISBLANK statement, I can't figure out how to get the position of the first cell upwards from the current one that isn't blank.
In this example spreadsheet, in the cell C7 I want to display the value of B7 minus the value of B4 (=B7-B4). The problem is that these values are separated by an unpredictable number of cells, which can range from 0 to 20 or even more. Needing to parse a spreadsheet with thousands of rows and frequent data added, selecting the upper cell manually is not an option.
In continuation of my example, I want C13 to display =B13-B10, but lets say there were two more blank rows in between them (row 13 becomes row 15), I would want it to display =B15-B10.
Can the position be obtained with a MATCH query, knowing that the Types will always be T1 or T2?
Thank you in advance.
Enter this formula in cell C2 and drag it to the bottom.
=IFERROR(IF(B2="","",B2-LOOKUP(9.99999999999999E+307,B$1:B1)),"")
Writing formulae via VBA
Below you find a VBA approach writing your subtracting formulae to column C.
BTW, searching via array is much more quicker than looping through a range.
Code
Option Explicit
Sub subtractLastValueRow()
' declare vars
Dim oSht As Worksheet ' work sheet
Dim a As Variant ' one based 2-dim data field array
Dim n As Long ' last row in column B
Dim i As Long ' item no
Dim ii As Long ' last item no
Dim j As Long
Dim s As String
' set sheet
Set oSht = ThisWorkbook.Worksheets("MySheet") ' fully qualified reference to worksheet
' get last row number of search column
n = oSht.Range("B" & oSht.Rows.Count).End(xlUp).Row
If n < 2 Then Exit Sub ' only if data avaible (row 1 = title line)
' get range (after title line) values to one based 2dim data field array
a = oSht.Range("B2:C" & n).Value ' array gets data from e.g. "A2:A100"
' loop through column B to find keyword sKey
If Len(a(1, 1) & "") > 0 Then ii = 1 + 1 ' first item in array
For i = LBound(a) + 1 To UBound(a) ' array boundaries counting from 1+1 to n -1 (one off for title line)
' value found
If Len(a(i, 1) & "") > 0 Then
For j = i + 1 To UBound(a)
If Len(a(j, 1) & "") > 0 Then
' write .Formula (alternatively use .Value, if value wanted)
oSht.Range("C" & i + 1).Formula = "=B" & i + 1 & "-B" & ii
ii = i + 1 ' note last found i
Exit For
End If
Next j
End If
Next
If Len(a(UBound(a), 1) & "") > 0 Then ' last item in array
oSht.Range("C" & UBound(a) + 1).Formula = "=B" & UBound(a) + 1 & "-B" & ii
End If
End Sub
Note
If you want to write values instead of work sheet formulae, simply replace .Formula with .Value.
In cell C3 put following formula:
=B3-LOOKUP(2,1/$B$1:B2,$B$1:B2)
And copy down in all T2 cells as required.
Excel 2010. I am trying to write a macro that could copy a set of data multiple times based on criteria on another sheet, but I've been stuck for a long time. I very much appreciate any help that could be offered to help me solve this problem.
Step 1: In the "Criteria" worksheet, there are three columns in which each row contains a specific combination of data. The first set of combination is "USD, Car".
Criteria worksheet
Step 2: Then the macro will move to the Output worksheet (please refer to the below link for screenshots), and then filter column A and B with the first set of criteria "USD" and "Car" in the "Criteria" worksheet.
Step 3: Afterwards, the macro will copy the filtered data into the last blank row. But the tricky part here is that, the filtered data has to be copied two times (as the "Number of set" column in the "Criteria" tab is 3 in this combination, and it doesn't have to copy the data three times since the filtered data would be treated as the first set of data)
Step4: After the filtered data have been copied, the "Set" column D will need to fill in the corresponding number of set that the rows are in. Therefore, in this 1st example, cell D2 and D8 will have "1" value, cell D14-15 will have "2" value, and cell D16-17 will have "3" value.
Step5: The macro will then move back to the "Criteria" worksheet and continue to based on the 2nd set of combination "USD, Plane" to filter the data in the "Output" worksheet. Again, it will copy the filtered data based on the "Number of set" in the "Criteria" worksheet. This process will continue until all the different combinations in the "Criteria" worksheet have been processed.
Output worksheet
Ok sorry for delay, here is a working version
you just have to add a sheet called "BF" because the autofilter count wasn't working properly so I had to use another sheet
Sub testfct()
Dim ShC As Worksheet
Set ShC = ThisWorkbook.Sheets("Criteria")
Dim EndRow As Integer
EndRow = ShC.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To EndRow
Get_Filtered ShC.Cells(i, 1), ShC.Cells(i, 2), ShC.Cells(i, 3)
Next i
End Sub
Sub Get_Filtered(ByVal FilterF1 As String, ByVal FilterF2 As String, ByVal NumberSetsDisered As Integer)
Dim NbSet As Integer
NbSet = 0
Dim ShF As Worksheet
Set ShF = ThisWorkbook.Sheets("Output")
Dim ColCr1 As Integer
Dim ColCr2 As Integer
Dim ColRef As Integer
ColCr1 = 1
ColCr2 = 2
ColRef = 4
If ShF.AutoFilterMode = True Then ShF.AutoFilterMode = False
Dim RgTotal As String
RgTotal = "$A$1:$" & ColLet(ShF.Cells(1, Columns.Count).End(xlToLeft).Column) & "$" & ShF.Cells(Rows.Count, 1).End(xlUp).Row
ShF.Range(RgTotal).AutoFilter field:=ColCr1, Criteria1:=FilterF1
ShF.Range(RgTotal).AutoFilter field:=ColCr2, Criteria1:=FilterF2
'Erase Header value, fix? or correct at the end?
ShF.AutoFilter.Range.Columns(ColRef).Value = 1
Sheets("BF").Cells.ClearContents
ShF.AutoFilter.Range.Copy Destination:=Sheets("BF").Cells(1, 1)
Dim RgFilt As String
RgFilt = "$A$2:$B" & Sheets("BF").Cells(Rows.Count, 1).End(xlUp).Row '+ 1
Dim VR As Integer
'Here was the main issue, the value I got with autofilter was not correct and I couldn't figure out why....
'ShF.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count
'Changed it to a buffer sheet to have correct value
VR = Sheets("BF").Cells(Rows.Count, 1).End(xlUp).Row - 1
Dim RgDest As String
ShF.AutoFilterMode = False
'Now we need to define Set's number and paste N times
For k = 1 To NumberSetsDisered - 1
'define number set
For j = 1 To VR
ShF.Cells(Rows.Count, 1).End(xlUp).Offset(j, 3) = k + 1
Next j
RgDest = "$A$" & ShF.Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":$B$" & (ShF.Cells(Rows.Count, 1).End(xlUp).Row + VR)
Sheets("BF").Range(RgFilt).Copy Destination:=ShF.Range(RgDest)
Next k
ShF.Cells(1, 4) = "Set"
Sheets("BF").Cells.ClearContents
'ShF.AutoFilterMode = False
End Sub
And the function to get column letter using an integer input :
Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function
I have 2 text boxes in a excel (or csv file) as below:
text box 1 contains (#11111,#22222,#33333), text box 2 contains (#55555)
#11111,#22222,#33333 #55555
I want the text between , to be on 3 different rows and repeat the text in 2nd text box so that it looks like below:
#11111 #55555
#22222 #55555
#33333 #55555
I am new to VBA. I am reading about string functions but I can't come up with logic on how to do it.
Any help would be appreciated.
Hi #tim williams - Thanks for the advice. I did manage to write a short code which accomplishes the task but it overwrites the text if I have any in 2nd row and 3rd row.
Sub splitcells()
Dim txt As String
Dim txt2 As String
Dim i As Integer
Dim cell1 As Variant
txt = Range("a1", "A1").Value
cell1 = Split(txt, ",")
For i = 0 To UBound(cell1)
Cells(i + 1, 1).Value = cell1(i)
Next i
txt2 = Range("b1", "b1")
For i = 1 To UBound(cell1)
Cells(i + 1, 2).Value = txt2
Next i
End Sub
Any advice on how to push the data on row 2 downwards .....
I do not know how to give you a hint that would help you adjust your macro so I have coded what I think you are after.
You talk about overwriting data in the 2nd or 3rd row so I assume you have several rows containing data in this format. I have therefore converted your code into a loop that works down column A until it finds a blank row.
I avoid overwriting data below the current row by inserting rows as necessary.
I have changed your code in ways that I believe makes the code more maintainable. I have explained my reasons for
these changes.
I have not explained the new statements I have used. It is generally easy to look up a statement once you know it exists but do ask questions if anything is unclear.
I hope this helps.
Option Explicit
Sub splitcells()
' * With VBA, Integer declares a 16-bit value while Long declares a 32-bit
' value. 16-bit values require special processing and are slower. So
' Long is preferred.
' * I do not like variable names such as i. It does not really matter with
' a tiny macro but with a larger macro it does. It does not matter now
' but it matters when you return to this macro in 6 or 12 months to amend
' it. You want to be able to look at variables and immediately know what
' they are. I have named variables according to my system. I am not
' asking you to like my system but to have a system. I can return to
' macros I wrote years ago and immediately recognise all the variables.
Dim InxSplit As Long
' Dim i As Integer
' * Split returns a string array. A Variant can be hold a string array but
' access is slower. Variants can be very useful but only use then when
' you need the flexibility they offer.
Dim SplitCell() As String
' Dim cell1 As Variant
Dim RowCrnt As Long
' * "Range" operates on the active worksheet. You are relying on the correct
' worksheet being active when the macro is called. Also, when you return
' to the macro in 6 or 12 months will you remember which worksheet is
' supposed to be active. ".Range" operates on the worksheet specified in
' the With statement. It doe not matter which worksheet is active and it
' is absolutely clear which worksheet is the target of this code.
With Worksheets("Sheet1")
RowCrnt = 1 ' The first row containing data.
Do While True
' * I use .Cells(row, column) rather than .Range because it is more
' convenient when you need to change the row and/or column numbers.
' * Note the column value can be a number or a column identifier.
' A = 1, B=2, Z=26, AA = 27, etc. I am not doing arithmetic with
' the columns so I have used "A" and "B" which I find more
' meaningful than 1 and 2.
If .Cells(RowCrnt, "A").Value = "" Then
Exit Do
End If
SplitCell = Split(.Cells(RowCrnt, "A").Value, ",")
If UBound(SplitCell) > 0 Then
' The cell contained a comma so this row is to be spread across
' two or more rows.
' Update the current row
.Cells(RowCrnt, "A").Value = SplitCell(0)
' For each subsequent element of the split value, insert a row
' and place the appropriate values within it.
For InxSplit = 1 To UBound(SplitCell)
RowCrnt = RowCrnt + 1
' Push the rest of the worksheet down
.Rows(RowCrnt).EntireRow.Insert
' Select the appropriate part of the original cell for this row
.Cells(RowCrnt, "A").Value = SplitCell(InxSplit)
' Copy the value from column B from the previous row
.Cells(RowCrnt, "B").Value = .Cells(RowCrnt - 1, "B").Value
Next
End If
RowCrnt = RowCrnt + 1
Loop
End With
End Sub