Can you guys help me out? I think i'm kind of stuck with the code below. I almost got the code that I wanted but at the end it does not do the thing I like.
Dim acs, cos, as_col, as_row As Integer
cos = Sheets.Count
acs = ActiveSheet.Index
as_LRow = Sheets(acs).Cells(Sheets(acs).Rows.Count, "A").End(xlUp).Row
For as_row = 3 To as_LRow
std_number = Sheets(acs).Cells(as_row, 1).Value
earliersheets = acs - 1
For s = 1 To earliersheets
ilast_row = Sheets(s).Cells(Sheets(s).Rows.Count, "A").End(xlUp).Row
For r = 3 To ilast_row
std_number_new = Sheets(s).Cells(r, 1).Value
If std_number = std_number_new Then
a = a & Sheets(s).Cells(r, 6).Value
'Sheets(acs).Cells(as_row, 8).Value = Sheets(s).Cells(r, 8).Value
Sheets(acs).Cells(as_row, 8).Value = Sheets(acs).Cells(as_row, 6).Value & " + " & a
End If
a = ""
Next r
Next s
Next as_row
What I want is:
After adding, manually, a new sheet I want to press on a button. This button activates the code above. What I want is to check a value in a particulaire cell in column "A". If the value in this column matches with the value from previous sheet then display the value in the sixth column in the newly added sheet. The code above does that, but it works only for two sheets. If I make more then two sheets it does not display more values then two.
Update
I added my file in the link: Check.xlsm
After opening this file clear the H-column in the third (and maybe the second sheet) then run the macro within. You'll see what I mean
All I want is to get all the previous values in previous sheet displaced in column-H. For example I marked two cells with values, these values get displayed in the H-column after running the macro.
Your problem was that you were always storing in column H a value created by taking the value from column F of the current sheet and appending the value from column F of the sheet being processed within the loop. When you move to the next sheet within the loop, you're replacing the previous value with a new value.
So, when processing sheet w3-6, you first look at sheet w1-4 and generate a value of "13 + 34" and store that in sheet w3-6's cell H3. Then you look at sheet w2-5 and generate a value of "13 + 18" and replace the value of "13 + 34" currently in sheet w3-6's cell H3 with the value of "13 + 18".
Try this code instead:
Dim acs As Long, cos As Long, as_col As Long, as_row As Long
Dim s As Long
Dim as_LRow As Long
Dim ilast_row As Long
Dim r As Long
Dim a As String
cos = Sheets.Count
acs = ActiveSheet.Index
as_LRow = Sheets(acs).Cells(Sheets(acs).Rows.Count, "A").End(xlUp).Row
For as_row = 3 To as_LRow
std_number = Sheets(acs).Cells(as_row, 1).Value
'Initialise variable containing result to go into column H
a = Sheets(acs).Cells(as_row, 6).Value
'Process earlier sheets in reverse order
'(so that values will be shown in reverse order)
For s = acs - 1 To 1 Step -1
ilast_row = Sheets(s).Cells(Sheets(s).Rows.Count, "A").End(xlUp).Row
For r = 3 To ilast_row
std_number_new = Sheets(s).Cells(r, 1).Value
If std_number = std_number_new Then
'Append value to result string
a = a & " + " & Cstr(Sheets(s).Cells(r, 6).Value)
Exit For
End If
Next r
Next s
'Store result
Sheets(acs).Cells(as_row, 8).Value = a
Next as_row
Related
The function is taking Sheet as string. I dont see which worksheet the sheet is referring to. Otherwise with slight modification i could have redirected to the worksheet i wanted. While debugging, i see the error of "subscript out of range"
Function TextFileInfoArrayFPP(WeeksToLoad As Integer, EndingRow As Integer, StartingRow As Integer, Sheet As String) As Variant
'check and adjust for non-edited values
Sheets("REF_FPP").Visible = Visible
Sheets("REF_UPB").Visible = Visible
Dim count As Integer
count = 0
'calc the new length for the new required array
For i = 0 To EndingRow - 1
For n = 0 To WeeksToLoad - 1
If Sheets(Sheet).Cells(StartingRow + i, 9 + n).Value <> Sheets("REF_" & Sheet).Cells(StartingRow + i, 9 + n).Value Then
count = count + 1
End If
Next n
Next i
ReDim FPPArray(count, 3 - 1) As Variant
'print column names (Date, PPR Line Item, Value)
FPPArray(0, 0) = "Date"
FPPArray(0, 1) = "PPR Line Item"
FPPArray(0, 2) = "Value"
count = 1
'this is the loop through weeks
For i = 0 To WeeksToLoad - 1
'this is the loop through line item
For n = StartingRow To EndingRow
If Sheets(Sheet).Cells(n, 9 + i).Value <> Sheets("REF_" & Sheet).Cells(n, 9 + i).Value Then
'print date
FPPArray(count, 0) = Sheets(Sheet).Cells(3, 9 + i).Value
'print PPR Line item
FPPArray(count, 1) = Sheets(Sheet).Cells(n, 1).Value
'print value
FPPArray(count, 2) = Sheets(Sheet).Cells(n, i + 9).Value
count = count + 1
End If
Next n
Next i
TextFileInfoArrayFPP = FPPArray
Sheets("REF_FPP").Visible = xlHidden
Sheets("REF_UPB").Visible = xlHidden
End Function
The function is taking Sheet as string. I dont see which worksheet the sheet is referring to. Otherwise with slight modification i could have redirected to the worksheet i wanted. While debugging, i see the error of "subscript out of range"
The VBA TextFileInfoArrayFPP function is a function that appears to be used in a Microsoft Excel workbook. The function takes several arguments as input, including WeeksToLoad, EndingRow, StartingRow, and Sheet. The function performs several operations on data contained in Excel spreadsheets and returns an array of output values.
Specifically, the function performed if the cells in a range of enabled cells on a given worksheet are different from the corresponding cells on another worksheet. If the cell values are different, the function adds those values to a table as rows with three columns: "Date", "PPR Line Item", and "Value". The function then returns this array as output.
thank you for the help in advance!
I am creating a macro that writes to a text file. I am having trouble referencing a range inside of a for loop. There are two examples I have where the range I have called returns a "". For the first image below, this is where the user inputs data using a combination of entering data into the sheet and using a button that directs them to a user form that plops in what they entered. In this first image, where the user is directed by the userform, the data is outputted to another sheet and I use vlookup to display the info. I do this to run operations on the other sheet and just to help me keep track of everything, (novice vba user). The second sheet is where data is stored and calculations are run.
1st image, User input and display 2nd image, data storage and calculation sheet
newDimName only outputs "_Cav" and the value stored in cavNum for the loop. The intention is concatenate the string inside of column A with more information depending on what the user has inputted. I suspect I am not referencing the range for column a correctly. The Loop is set to go to 2 to whatever amount of "dimensions" have been entered by the user (value in lastUserDim). The code below is contained with a sheet reference (not in the snippet) so it references the correct sheet. Ex. "With Sheet2", at before the loop and a "End With" at the end of the loop.
Dim a As Integer, cavNum As Integer
Select Case numCav
Case Is = 4
For a = 2 To lastUserDim
For cavNum = 1 To 4
newDimName = Cells(a, 1) & "_Cav" & cavNum
Next cavNum
Next a
totalColumns = 4 * lastUserDim
Case Is = 8
For a = 2 To lastUserDim
For cavNum = 1 To 8
newDimName = Cells(a, 1) & "_Cav" & cavNum
Next cavNum
Next a
totalColumns = 8 * lastUserDim
Case Is = 16
For a = 2 To lastUserDim
For cavNum = 1 To 16
newDimName = Cells(a, 1) & "_Cav" & cavNum
Next cavNum
Next a
totalColumns = 16 * lastUserDim
Case Is = 32
For a = 2 To lastUserDim
For cavNum = 1 To 32
newDimName = Cells(a, 1) & "_Cav" & cavNum
Next cavNum
Next a
totalColumns = 32 * lastUserDim
Case Else
MsgBox "Please select what # of cavities this tool has."
End Select
For the code below, I want the the range I defined to be read and for the select case to determine if a cell contains yes or no. The loop is intended to run this operation for number of user inputted data. Again I suspect I am not calling the data in column c correctly like I was previously with Column A. I tried using cells like in the first code snippet, just range, range("").value, and range("").text.
Dim LSLBound As String, LSLBoundRef As String
Dim c As Integer
For c = 2 To lastUserDim
LSLBoundRef = Range("C2:C" & c).Text 'ref to cell value to use for select case
Select Case LSLBoundRef
Case Is = "No"
LSLBound = "LBound 1;"
Case Is = "Yes"
'Do Nothing
End Select
Next c
If the second code snippet is wrapped in a "With Sheet2", you need to preface the Range with a period, ie **.**Range("C2")... so that it is using the correct sheet.
Dim LSLBound As String, LSLBoundRef As String
Dim c As Integer
With Sheets("Sheet2")
For c = 2 To lastUserDim
LSLBoundRef = .Range("C2:C" & c).Text 'ref to cell value to use for select case
Select Case LSLBoundRef
Case Is = "No"
LSLBound = "LBound 1;"
Case Is = "Yes"
'Do Nothing
End Select
Next c
End With
A good way to figure out what range is actually being referenced is by printing the range address to the immediate window with Debug.Print Range.Address.
I have existing script that does a major chunk of what I need. The script (from here: https://www.extendoffice.com/documents/excel/4054-excel-duplicate-rows-based-on-cell-value.html) basically inserts and then copies rows of data X number of times, where X is one of the fields in the table. It works well and the referenced page shows examples of the start and end points.
But when I run the script in Excel I go from ~2,000 lines in my table to ~40,000 lines. I need to modify all the duplicated rows (incremental dates) and so I am now attemting to also include new data into the table while the script runs that will allow me to change data in the duplicated rows... for example I can use the duplicate number 1, 2, 3, 4 and some simple formulas to change dates relative to a start point.
I expect that I will need some additional code inserted into the routine that will add data into a nominated column and do the auto incrementing from 1.
Having zero actual VBA skillz, ive no idea how to tackle the second part of my problem with the code I already have. Any help would be totally awesome !!
Sub CopyData()
'Updateby Extendoffice 20160922
Dim xRow As Long
Dim VInSertNum As Variant
xRow = 1
Application.ScreenUpdating = False
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "D")
If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
Selection.Insert Shift:=xlDown
xRow = xRow + VInSertNum - 1
End If
xRow = xRow + 1
Loop
Application.ScreenUpdating = False
End Sub
Try this code below, I used the same sample data on the link you provided. However on this code I created 2 worksheets, one for the raw data to be processed and one for the duplicate output including the increment of dates and duplicate number.
Sub duplicateData()
Dim rSH As Worksheet
Set rSH = ThisWorkbook.Sheets("RAW") 'Your raw data
Dim oSH As Worksheet
Set oSH = ThisWorkbook.Sheets("OUTPUT") 'Output data on another sheet
x = 2
For a = 2 To rSH.Range("A" & Rows.Count).End(xlUp).Row
For b = 1 To rSH.Cells(a, 4).Value '4 is the column of duplicate times
If b = 1 Then
For c = 1 To 4 'Number of your column
oSH.Cells(x, c).Value = rSH.Cells(a, c).Value
Next c
oSH.Cells(x, 5) = 1 'First instance, 5 is the column number of duplicate counter
Else
For c = 1 To 4 'Number of your column
oSH.Cells(x, c).Value = rSH.Cells(a, c).Value
Next c
oSH.Cells(x, 3).Value = CDate(oSH.Cells(x - 1, 3).Value) + 1 '3 is the column number of date to increment
oSH.Cells(x, 5).Value = CInt(oSH.Cells(x - 1, 5).Value) + 1 '5 is the column number of duplicate counter
End If
x = x + 1 'Increment Output row number
Next b
Next a
End Sub
So, I haven't figured out how to do this.
Basically, I want something like this:
P1 P2 P3 TOTAL SCORE
-- -- -- P1 P2 P3
21 / 13 1 2 0
/ 17 10
6 7 /
So, the three columns must compare to one-another (the "/" means that the player didn't play that game, but it doesn't have to be printed), the greatest among the three gets a +1 value in the TOTAL SCORE tab.
Plus, is there any easier way to do this than comparing one cell to another cell? I mean, is there a possibility to drag and mark all cells on all of the three columns and make sure that they only compare the cells in the three columns IN THE SAME ROW?
Let us assume that the data appears as in the picture in Sheet1 (Don't change the structure):
Open an Excel
Press ALT & F11 to open Visual Editor
Add a module from > Insert (in the Upper toolbar) - Module ( third option)
Paste the below codes & execute Sub Evaluation() (press F5 when your cursor is in Sub Evaluation)
To store lastrow in order to continue from the next record i use sheet2 range A1
Try:
Option Explicit
Public Sub Process_Data(ByVal I_Value As Long)
Dim LastRow As Long
Dim i As Long
Dim CA As Integer
Dim CB As Integer
Dim CC As Integer
With Sheet1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = I_Value To LastRow '<= Lets say that the first score is at sheet1 column A row 3.LastRow represent the row of the last data in column A
CA = 0
CB = 0 '<= Every time that i change value we zero our variables to get the new value
CC = 0
If .Range("A" & i).Value = "/" Then '<= Check if there is a number or "/".if there is "/" we zero variable
CA = 0
Else
CA = .Range("A" & i).Value
End If
If .Range("B" & i).Value = "/" Then
CB = 0
Else
CB = .Range("B" & i).Value
End If
If .Range("C" & i).Value = "/" Then
CC = 0
Else
CC = .Range("C" & i).Value
End If
If CA > CB And CA > CC Then ' <= Check which number is bigger
.Range("E3").Value = .Range("E3").Value + 1 '<= At one point to each category
ElseIf CB > CA And CB > CC Then
.Range("F3").Value = .Range("F3").Value + 1
ElseIf CC > CA And CC > CB Then
.Range("G3").Value = .Range("G3").Value + 1
End If
Next i
End With
End Sub
Sub Evaluation()
Dim Value As Long
Dim LastRow As Long
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
If (LastRow = 2) Or (LastRow = Sheet2.Range("A1").Value) Then '<= Check if the table has new data
Exit Sub
Else
If Sheet2.Range("A1").Value = "" Then '<=Check which value will adopt be i
Value = 3
Else
Value = Sheet2.Range("A1").Value + 1
End If
End If
Call Process_Data(I_Value:=Value)
Sheet2.Range("A1").Value = Sheet1.Range("A" & Rows.Count).End(xlUp).Row '<= Record the lastrow processed out
End Sub
Use the LARGE function to find the highest number for the individual games on the left. Then use an IF statement out to the right to check if the value of the LARGE function matches the player's game score. If it does match (TRUE), assign a value of 1. If it doesn't match (FALSE), assign a value of 0. Then SUM each player's modifiers that you've assigned with the IF function.
If ties are possible in the individual game scores, you'll also need to nest another IF function to handle that possibility.
I have a table where user can insert multiple rows over multiple columns where some data is string and some numeric. I want to create a button such that when the user clicks it, it will create a new table on the same excel sheet but with some of the rows combined based on predefined condition.
Eg. The table "pre defined condition" states that alpha and gamma are similar and so on(it can many rows like this which show the conditions to combine rows..condition will always pertain to second row of the user defined table i.e table 1)...Table 1 will be created by a different user and he can enter as many rows as he wishes to. So using these 2 tables (Table 1 & Pre defined condition tabel) I want to create a new table which has certain rows combined with stringfrom two rows separated using "/" and numbers added.
The structure will remain the same for all tables.
Edit:One value in column 2 will always have same value in column 1.Basically column 2 is a dependent list(on column 1 ). There can be many pre -defined conditions and not just limited to 2 . Usually there won't be any duplicate values in column 2,but in case there are I want to combine them in a row at click of the button.
Table 1
A Alpha 100 1
B Beta 200 2
C Gamma 300 3
D Kappa 400 4
Pre Defined Condition
Alpha Gamma
Beta Kappa
Desired Output
A/C Alpha/Gamma 400 4
B/D Beta/Kappa 600 6
Assuming that your data starts in A2:D2 (A1:D1 left for titles), that you state two conditions (for example Alpha Gamma) in columns F and G (starting in the second row; first row left for titles), that there is a command button, and that the worksheet is named "Sheet1", the following code should do the trick.
Dim i As Integer
Dim j As Integer
Dim lLastRowPDC As Integer
Dim lLastRowData As Integer
Dim sConditions As String
Dim sOrigin As String
Dim sColumnA As String
Dim sColumnB As String
Dim iColumnC As Integer
Dim iColumnD As Integer
Private Sub CommandButton1_Click()
lLastRowPDC = Worksheets("Sheet1").Cells(2, 6).End(xlDown).Row 'Rows with Conditions, starting in the second row
lLastRowData = Worksheets("Sheet1").Cells(2, 1).End(xlDown).Row 'Rows with data, starting in the second row
For i = 2 To lLastRowPDC
sConditions = Worksheets("Sheet1").Cells(i, 6).Value & Worksheets("Sheet1").Cells(i, 7).Value 'create a string with the two conditions
sColumnA = ""
sColumnB = ""
iColumnC = 0
iColumnD = 0
For j = 2 To lLastRowData
sOrigin = Worksheets("Sheet1").Cells(j, 2).Value
If InStr(sConditions, sOrigin) > 0 Then
If InStr(sColumnA, Worksheets("Sheet1").Cells(j, 1).Value) = 0 Then
sColumnA = sColumnA & Worksheets("Sheet1").Cells(j, 1).Value & "/"
End If
If InStr(sColumnB, Worksheets("Sheet1").Cells(j, 2).Value) = 0 Then
sColumnB = sColumnB & Worksheets("Sheet1").Cells(j, 2).Value & "/"
End If
iColumnC = iColumnC + Worksheets("Sheet1").Cells(j, 3)
iColumnD = iColumnD + Worksheets("Sheet1").Cells(j, 4)
End If
Next j
sColumnA = Left(sColumnA, Len(sColumnA) - 1) 'remove last "/"
sColumnB = Left(sColumnB, Len(sColumnB) - 1) 'remove last "/"
Worksheets("Sheet1").Cells(i, 8).Value = sColumnA
Worksheets("Sheet1").Cells(i, 9).Value = sColumnB
Worksheets("Sheet1").Cells(i, 10).Value = iColumnC
Worksheets("Sheet1").Cells(i, 11).Value = iColumnD
Next i
End Sub