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.
Related
I have a question to a project of mine. I have a Worksheet with 6 columns of data. 1 with dates and 5 with percentages. What I want is to find the dates where the data fall below a certain threshold and then from there find the minimum value and find the length of the period until an empty cell which marks the point where the point where the data value has recovered. I loop over rows and columns and save the data in a collection which add new data to an array (variant()). The problem is that I don't know how to start adding in the next array column after each inner loop. Also I save two inputs the array for each period below each other. A long that gives me the number of days and a string with two dates that shows the period. Ideally they should also be split into their own column (every second input must get to the same column). Alternatively, this second problem might be solved when extracting the array to Excel?
I hope the question is clear and I included all relevant information
Thank you
Dim varDates As Variant, varAll As Variant, varMyArray() As Variant
dblDDLim = Range("BD8").Value ' the threshold value
Range("BB10").Select
varDates = Range(Selection, Selection.End(xlDown)).Value ' dates in time series
Range("BC10").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
varAll = Selection.Value ' all data in 5 columns
' loops though columns and rows
For i = LBound(varAll, 2) To UBound(varAll, 2)
For j = LBound(varAll, 1) To UBound(varAll, 1)
Cells(9 + j, 54 + i).Select
If varAll(j, i) <> "" Then
ReDim Preserve dtTemp(lngCounter)
dtTemp(lngCounter) = varDates(j, 1)
'data
ReDim Preserve varTemp(lngCounter): varTemp(lngCounter) = varAll(j, i)
lngCounter = lngCounter + 1
Else
If lngCounter > 0 Then
If WorksheetFunction.Min(varTemp) < dblDDLim Then
intMin = IsInArray_Index_oneDim(WorksheetFunction.Min(varTemp), varTemp) ' finds index of the minimum within the period
lngPerLen = UBound(varTemp, 1) - intMin + 1 'length as number of days
col.Add lngPerLen ' dynamically add value to the end
strRecLen = dtTemp(intMin) & " - " & dtTemp(UBound(dtTemp)) 'recover length as start date to end date
col.Add strRecLen
lngPerCounter = lngPerCounter + 1 'counts the number of periods
varMyArray = Collection2Array(col) 'convert collection to an array
End If
End If
'counts # of observations in the series
lngCounter = 0
End If
Next
Next
Public Function Collection2Array(col As Collection)
Dim MyArray() As Variant
Dim i As Integer
ReDim MyArray(0 To col.Count - 1) As Variant
For i = 1 To col.Count
MyArray(i - 1) = col(i)
Next
Collection2Array = MyArray
End Function
I'm fairly new to Excel VBA and still learning the ropes, so I need help with a step by step program without using any functions. I understand how to count through an unknown column range and output the quantity. However, for this program, I'm trying to loop through a column, picking out unique numbers and counting its frequency.
So I have an excel file with random numbers down column A. I only put in 20 numbers but let's pretend the range is unknown. How would I go about extracting the unique numbers and inputting them into a separate column along with how many times they appeared in the list?
I have a code, but it's not working and I don't know why.
Public Sub CreateInventoryReport()
Dim bcode As Long
Dim ubcode As Long
'Below is the part that is not working
If Worksheets("Sheet 2").Range("A1")<>" Then
' First Value Is unique
Worksheets("Sheet2").Range("D5") = Worksheets("Sheet2").Range("A1")
Worksheets("Sheet2").Range("E5") = 1
Else
r = MsgBox("no data", , "no data")
Exit Sub
End If
bcode = 2
Do While Worksheets("Sheet 2").Cell(bcode, 1) <> ""
ubcode = 5
IsMatch = False
Do While Worksheets("Sheet 2").Cell(ubcode, 4) <> ""
If Worksheets("Sheet 2").Cell(bcode, 1) = Worksheets("Sheets2").Cell(ubcode, 4) Then
Worksheets("Sheet 2").Cell(ubcode, 5) = Worksheets("Sheet2").Cell(ubcode, 5) + 1
IsMatch = True
Exit Do
End If
ubcode = ubcode + 1
Loop
If IsMatch = False Then
Worksheets("Sheet2").Cell(ubcode, 4) = Worksheets("Sheet2").Cell(bcode, 1)
Worksheets("Sheet 2").Cell(ubcode, 5) = 1
End If
bcode = bcode + 1
Loop
End Sub
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
I have a large table, sometimes with hundreds of rows.
This table is generated by another application that exports to excel.
One column has the heading "Adjusted Price".
I want all the rows in this column to contain a formula (presently they're all 0's).
I want to automate this process because the table gets regenerated all the time.
This column may not always be in the same place. So I need a macro that can find this column ("Adjusted Price") and then fill all the cells in that column with a formula (with the exception of the first row of course).
Can this be done?
Thanks in advance :)
Your homework is to figure out how to plug it in!
Option Explicit
Sub setAdjustedPrice()
Dim column As Integer
Dim adjustedPriceColumn As String
Dim found As Boolean
Dim rowCount As Long
column = 1
rowCount = 1
Do While Range(FncAlphaCon(column) & rowCount).Value <> "" And found = False
If (Range(FncAlphaCon(column) & rowCount).Value = "Adjusted Price") Then
found = True
adjustedPriceColumn = FncAlphaCon(column)
Else
column = column + 1
End If
Loop
If found = True Then
Do While rowCount < ActiveSheet.UsedRange.Rows.count
rowCount = rowCount + 1
Range(adjustedPriceColumn & rowCount) = "YOUR FORMULA"
Loop
Else
MsgBox ("'Adjusted Price' column not found, cannot continue.")
End If
End Sub
Private Function FncAlphaCon(aNumber As Integer) As String
' Fixed version 27/10/2011
Dim letterArray As String
Dim iterations As Integer
letterArray = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If aNumber <= 26 Then
FncAlphaCon = (Mid$(letterArray, aNumber, 1))
Else
If aNumber Mod 26 = 0 Then
iterations = Int(aNumber / 26)
FncAlphaCon = (Mid$(letterArray, iterations - 1, 1)) & (Mid$(letterArray, 26, 1))
Else
'we deliberately round down using 'Int' as anything with decimal places is not a full iteration.
iterations = Int(aNumber / 26)
FncAlphaCon = (Mid$(letterArray, iterations, 1)) & (Mid$(letterArray, (aNumber - (26 * iterations)), 1))
End If
End If
End Function
I have an excel spreadsheet. In a column of the spreadsheet I have a list of codes (numbers).These codes (numbers) are sorted from highest to lowest values.(some of these codes has been repeated. For example I have three consecutive line with code 1001200).I want to insert new rows between each codes (in case of having repeated codes i just need one new row (for example i Just need one new row for 1001200 not 3 rows) .
I have written the following code but it does not work.
Sub addspace()
Dim space_1(5000), Space_2(5000)
For n = 1 To 5000
Debug.Print space_1(n) = Worksheets("sheet3").Cells(1 + n, 1).Value
Debug.Print Space_2(n) = Worksheets("sheet3").Cells(2 + n, 1).Value
Next
For n = 1 To 5000
If space_1(n) <> Space_2(n) Then
Range("space_1(n)").EntireRow.Insert
End If
Next
End Sub
How can I fix it? (From the code you can see that I am so beginner :)))
Cheers
To insert one empty row between each unique value try this:
Option Explicit
Public Sub addspace()
Dim i As Long
Application.ScreenUpdating = False
With Worksheets("sheet3")
For i = 5000 To 2 Step -1
While .Range("A" & i - 1) = .Range("A" & i)
i = i - 1
Wend
.Rows(i).Insert Shift:=xlDown
Next
End With
Application.ScreenUpdating = True
End Sub
It starts from the end row and moves up, skipping duplicates
The Range("space_1(n)") is invalid. Arg of range object should be a column name like "A1", you can use Range("A" & n).EntireRow.Insert in your code. But I recommend my code.
Please try,
Sub addspace()
Dim n As Integer
For n = 1 To 5000
If Worksheets("sheet3").Cells(n, 1).Value <> Worksheets("sheet3").Cells(n + 1, 1).Value Then
Worksheets("sheet3").Cells(n + 1, 1).EntireRow.Insert
n = n + 1
End If
Next
End Sub