Why is this loop selecting multiple cells with the Areas function? - excel

I have this loop to select the items in a column in a cell by cell basis, and test each against the previous. Every once in a while, maybe 2 to 4 times in 100 loops, Areas. selects two cells, and the code throws an error, type mismatch, since it cannot compare value of 2 cells. Why is this happening?
I have tried to use alternate methods to loop through the cells, and am open to suggestions, but this is the way that I have found has mostly worked since I want to loop through just visible cells.
Dim Fchours As Range
Set Fchours = ActiveSheet.Range(rng1.Address).SpecialCells _
(xlCellTypeVisible)
Do While i < 328
If ActiveSheet.FilterMode = True Then
Fchours.Areas(i + 1).Select
If ((Fchours.Areas(i + 1).Value) <> "") Then
If (Fchours.Areas(i).Value) < 5000 Then
If ((Fchours.Areas(i + 1).Value) < (Fchours.Areas(i).Value)) Then
FCcount = FCcount + 1
End If
End If
End If
End If
i = i + 1
Loop
I expect it to select individual cells at a time, and most of the time it does, just every now and again it selects 2.

Related

VBA to enter value into top X visible cells of filtered data within a loop

I am working on sampling solution for my QA team where the production file on excel is randomized and a sample of each user is considered for QA purposes. I need to loop through the visible cells of a filtered range and select the top x (variable defined) rows. I am unable to paste the code I have because of the restrictions on my client's systems so just going to type out the code on the exact area I'm stuck at. I've tried different combinations on the loop below but either all visible cells are getting the value "QA Selected" or it is just the first row. I only need it for the number of rows as per the sample. The For Each cell in range section is not stopping once the sample count is met.
For example, if user John123 has processed 500 alerts on a certain day, my sample of 10% would mean 50 randomly selected alerts. On any given day I have about 20 different users processing alerts. My code currently picks the data, randomizes it, turns on autofilter and loops through each user's production data. I just need VBA to select the top 50 (in this case) alerts i.e visible rows by entering "QA Selected" into the cell. The code would then filter on the next user and select the top 30 alerts (if production is 300 alerts) and so on.
Set filter_rng = Sheets("PS_Extract").Range("AL2:AL" & lastrow2)
For i = 1 to lastrow
Sheets("PS_Extract").Range("A:AL").Autofilter
Sheets("PS_Extract").Range("A:AL").Autofilter field:=21, Criteria:=Sheets("Notes").Range("A") & i)
SampleSize = Sheets("Notes").Range("C" & i)
For each cell in filter_rng.SpecialCells(xlCellTypeVisible) 'this loop is the block where I am facing the issue
For j = 1 to SampleSize
Sheets("PS_Extract").Range("AL" & cell.Row).Value = "QA Selected"
j = j + 1
If j = SampleSize Then Exit For
Next j
Next cell
After you made sure that SampleSize is an integer value (a whole number), you could try the following:
j = 0
For Each cell In filter_rng.SpecialCells(xlCellTypeVisible)
j = j + 1
Sheets("PS_Extract").Range("AL" & cell.Row).Value = "QA Selected"
If j = SampleSize Then Exit For ' maybe '> SampleSize - 1' if not integer
Next cell
When counting inside an inner loop, you have to reset the counter (j = 0).

VBA Insert set number of rows if string found

I am new to macros in Excel, and I’m trying to speed up a process. I need to add a varying number of blank rows, if certain text is present in the cell above it. Not equal, but containing.
For example if A1 contains 'Apples', add two blank rows beneath. If A6 has 'Plums', add four blank rows beneath, etc.
What I have now is this:
For a=1 To ActiveSheet.Cells(Rows.Count,1).End(x1Up).Row
If ActiveSheet.Cells(a,1).Value = “Apples” Then
ActiveSheet.Rows(2).Insert
a = a+1
ELSE
If ActiveSheet.Cells(a,1).Value = “Plums” Then
ActiveSheet.Rows(4).Insert
a = a+1
End If
End Sub
So far I've gotten a Compile Error, stating "Block If without End If" though I believe I closed them both. I'm not sure if I'm correctly comparing or searching for a string as well (referring to my use of ="Apples"), but cannot get it to run at all to test that part.
For a = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If TypeName(ActiveSheet.Cells(a, 1)) = "String" Then
If ActiveSheet.Cells(a, 1).Value = "Apples" Then
ActiveSheet.Rows(2).Insert
a = a + 1
ElseIf ActiveSheet.Cells(a, 1).Value = "Plums" Then 'One error here
ActiveSheet.Rows(4).Insert
a = a + 1
End If
End If
Next 'And here too

Excel VBA: Dynamically Changing Function Based on Column

Heylo, I am trying to write an excel function that takes a user-selected range and performs different calculations based on the column the cell being populated lines up with. The screenshot below shows the setup of the columns.
I want to set AA5 to be "=myFunction($AA1:$AD4)", and then I want click-and-drag to use the autofill feature to populate AB5, AC5, and AD5 with the same "=myFunction($AA1:$AD4)" but this myFunction will do different things based on which cell is being populated during the autofill.
I know how to do this in a subroutine where the user would select the first open cell AA5, and is prompted for the range to use for calculations. I would do something along the lines of:
Sub CalcCells()
Dim myRange As Range
Set myRange = Application.InputBox("Select the cells you want to use...", Type:=8)
Dim numColumn As Long
For numColumn = 0 To myRange.Columns.Count - 1
Select Case numColumn
Case Is = 0
ActiveCell.Offset(0, numColumn).Formula = "=SUM(" + myRange.Columns(1) + ")"
Case Is = 1
ActiveCell.Offset(0, numColumn).Formula = "=SUMPRODUCT(" + myRange.Columns(1) + "," + myRange.Columns(2) + ")"
Case Is = 2
ActiveCell.Offset(0, numColumn).Formula = "=SUMPRODUCT(" + myRange.Columns(1) + "," + myRange.Columns(3) + ")/SUM(" + myRange.Columns(1) + ")"
Case Is = 3
ActievCell.Offset(0, numColumn).Formula = "=SUMSQ(" + myRange.Columns(4) + ")"
End Select
Next numColumn
End Sub
So basically I want to do exactly this, but I want it to be a function that when I click and drag and autofill AB5:AD5 it knows which column the cell lines up with and performs a calculation based on that, and uses it as an argument/parameter almost. It will not always be 4 rows either, so it needs to be capable of accommodating varying row counts, but the .Columns should work with that as long as the user selects only the same datatype.
Is this possible and how can I do it? Thank you for any help in advance. I've done a lot of searching and I don't know if I'm not searching the right way, but i cannot find anything that really helps.
What about something like this? Basically, you get the column of the cell you enter the formula into with Application.Caller.Column. Then inputRange.Column gives you the leftmost column of your input range. Based on the difference of the two, you know which worksheet function you want to use. If the difference is 0, your formula is entered in the 1st column, so you use Sum. If the difference is 1, you use Sumproduct, and so on.
Function SummarizeCells(inputRange As Range) As Double
Dim col As Long
col = Application.Caller.Column - inputRange.Column
Select Case col
Case 0
SummarizeCells = WorksheetFunction.Sum(inputRange.Columns(1))
Case 1
SummarizeCells = WorksheetFunction.SumProduct(inputRange.Columns(1), inputRange.Columns(2))
Case 2
SummarizeCells = WorksheetFunction.SumProduct(inputRange.Columns(1), inputRange.Columns(3)) / WorksheetFunction.Sum(inputRange.Columns(1))
Case 3
SummarizeCells = WorksheetFunction.SumSq(inputRange.Columns(4))
End Select
End Function
A sample view here:

Getting excel to put together split strings

I'm trying to get excel to put together a series of text strings that haven't been formatted systematically, so that they end up split into different rows on a data sheet.
I'm aware this might've been solved elsewhere so sorry for that but I'm struggling to describe the issue, and I can't post images on it but basically it's
Column 1 with a list of the entries, and
Column 2 with text strings that are spread over 2 or more rows
Is it possible to write some kind of formula or macro that would be able to check the first column and then stitch together all entries in the second column going down until it found a new entry in the first column? I've got a feeling it might be possible using some sort of loop thing with index functions, but I've no idea where to start even.
Thanks,
Mike
Mike give this a ty
Sub appendValues()
'The sub is designed to loop through code and when ever there is a null value and column a it will take the value of what is in column B and appended to the row above it and delete the row.
Dim row As Integer
row = 1
'This code starts with row one but this can be changed at will.
Do Until ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value = ""
'loop statement is designed to continue to Loop until there is a null value inside of you the value in the second column.
If ThisWorkbook.Sheets("sheet1").Cells(row, 1).Value = "" Then
ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value = ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value & ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value
Rows(row).Delete
Else
'else statement is needed because there is an implied looping by decreasing the total number of rows after the delete.
row = row + 1
End If
Loop
End Sub
Sub appendValues()
'The sub is designed to loop through code and when ever there is a null value and column a it will take the value of what is in column B and appended to the row above it and delete the row.
Dim row As Integer
row = 1
'This code starts with row one but this can be changed at will.
Do Until ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value = ""
'loop statement is designed to continue to Loop until there is a null value inside of you the value in the second column.
If ThisWorkbook.Sheets("sheet1").Cells(row, 1).Value = "" Then
ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value = ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value & ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value
Rows(row).Delete
Else
'else statement is needed because there is an implied looping by decreasing the total number of rows after the delete.
row = row + 1
End If
Loop
End Sub

How do I get excel to merge cells only when other cells are filled?

I need to merge cells using a formula so that the cells only merge when cells on another tab are filled.
I have 2 tabs with the same amount of columns in each. I want cells a1-d1 to merge in tab 1 when cells a1-d1 in tab 2 are filled and for the value of d1 in tab 2 to be inputted into the newly merged cells in tab 1.
this is what I have:
Excel VBA Methods and Function (Excel Macros) overview
Since you want to change cells i do not believe that you can use a formula (even not a user defined one). Therefore i wrote an excel vba macro for your problem.
FirstRows(): Is the starting point. It loops over 10 rows and calls the other methods
CheckEmptyCellValues(curRow): This method checks for empty cells in tab2 (sheet 2 in excel)
MergeCells(curRow) takes the current row as a number (any integer from 1 to max amount of rows) and merges the cells from column 1 to 4 on Sheet 1 (the first sheet in excel)
Fully working demo tested with 4 columns and 10 rows
Sub FirstRows()
Sheets(1).Select
For curRow = 2 To 11
Merge = CheckEmptyCellValues(curRow)
If Merge = 4 Then
MergeCells (curRow)
cellValue = Sheets(2).Cells(curRow, 4).Value
Sheets(1).Cells(curRow, 1).Value = cellValue
End If
Next
End Sub
Sub MergeCells(curRow)
Sheets(1).Select
Range(Cells(curRow, 1), Cells(curRow, 4)).MergeCells = True
End Sub
Function CheckEmptyCellValues(curRow)
Merge = 0
Sheets(2).Select
For i = 1 To 4
If Len(Cells(curRow, i).Value) > 0 Then
Merge = Merge + 1
End If
Next
CheckEmptyCellValues = Merge
End Function
Below you can see the result. The values from sheet 2 haven been copied to sheet 1 (second image). In Sheet 1 the Cells in a row are merged (in row 2 from Cell A2 up to Cell D2 (A2-D2 is now just one cell) if in the first image (sheet 2) every cell (from column a to column d) in a row had a value.
Bugs in the modified code
There are a few things in the modifiend code that are not possible or could lead to a wrong understanding
Function CheckEmptyCellValues(curColumn)
Merge = 0
Sheets(2).Select
For i = A To d
If Len(Cells(curColumn, 11).Value) > 0 Then
Merge = Merge + 1
End If
Next
CheckEmptyCellValues = Merge
End Function
The line For i = A To d is not possible. If you want to use a loop you have to use numbers: For i = 1 To 4 this would repeat the code between For and Next4 times starting with 1
This line Cells(curColumn, 11).Value is technical correct but misleading. Excel uses the first value after (for the row-index and the second value for the column-index. Both values have to be a number: Cells(4,2).Value returns the Cell value from the 4th. row and the second Column (in the Excel Gui the Cell B4)
Try changing this line For i = A To d to this For i = 1 To 4 and see if that returns the wished result.
Bugs part 2
In your other modification you have some of the same bugs:
The loop For curColumn = A to d needs numbers instead of letters (unless A and d were a variable filled with a number but according to your code sample this is not the case
The line cellValue = Sheets(2).Cells(curColumn, d).Value has the same bug, if d is just the letter d and not something like d = 4 than you can not use it in a loop.
This is the code from your comment:
Sub FirstRows()
Sheets(1).Select
For curColumn = A To d
Merge = CheckEmptyCellValues(curColumn)
If Merge = d Then
MergeCells(curColumn)
cellValue = Sheets(2).Cells(curColumn, d).Value
Sheets(1).Cells(curColumn, d).Value = cellValue
End If
Next
End
Sub Sub MergeCells(curColumn)
Sheets(1).Select
Range(Cells(curColumn, 1), Cells(curColumn, d)).MergeCells = True
End Sub
Be carefull it is not running.

Resources